Prepare Module::CoreList for 5.19.12 (not that it's expected to exist...)
[perl.git] / hv.c
1 /*    hv.c
2  *
3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
4  *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  *
9  */
10
11 /*
12  *      I sit beside the fire and think
13  *          of all that I have seen.
14  *                         --Bilbo
15  *
16  *     [p.278 of _The Lord of the Rings_, II/iii: "The Ring Goes South"]
17  */
18
19 /* 
20 =head1 Hash Manipulation Functions
21
22 A HV structure represents a Perl hash.  It consists mainly of an array
23 of pointers, each of which points to a linked list of HE structures.  The
24 array is indexed by the hash function of the key, so each linked list
25 represents all the hash entries with the same hash value.  Each HE contains
26 a pointer to the actual value, plus a pointer to a HEK structure which
27 holds the key and hash value.
28
29 =cut
30
31 */
32
33 #include "EXTERN.h"
34 #define PERL_IN_HV_C
35 #define PERL_HASH_INTERNAL_ACCESS
36 #include "perl.h"
37
38 #define DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */
39 #define HV_FILL_THRESHOLD 31
40
41 static const char S_strtab_error[]
42     = "Cannot modify shared string table in hv_%s";
43
44 #ifdef PURIFY
45
46 #define new_HE() (HE*)safemalloc(sizeof(HE))
47 #define del_HE(p) safefree((char*)p)
48
49 #else
50
51 STATIC HE*
52 S_new_he(pTHX)
53 {
54     dVAR;
55     HE* he;
56     void ** const root = &PL_body_roots[HE_SVSLOT];
57
58     if (!*root)
59         Perl_more_bodies(aTHX_ HE_SVSLOT, sizeof(HE), PERL_ARENA_SIZE);
60     he = (HE*) *root;
61     assert(he);
62     *root = HeNEXT(he);
63     return he;
64 }
65
66 #define new_HE() new_he()
67 #define del_HE(p) \
68     STMT_START { \
69         HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]);    \
70         PL_body_roots[HE_SVSLOT] = p; \
71     } STMT_END
72
73
74
75 #endif
76
77 STATIC HEK *
78 S_save_hek_flags(const char *str, I32 len, U32 hash, int flags)
79 {
80     const int flags_masked = flags & HVhek_MASK;
81     char *k;
82     HEK *hek;
83
84     PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
85
86     Newx(k, HEK_BASESIZE + len + 2, char);
87     hek = (HEK*)k;
88     Copy(str, HEK_KEY(hek), len, char);
89     HEK_KEY(hek)[len] = 0;
90     HEK_LEN(hek) = len;
91     HEK_HASH(hek) = hash;
92     HEK_FLAGS(hek) = (unsigned char)flags_masked | HVhek_UNSHARED;
93
94     if (flags & HVhek_FREEKEY)
95         Safefree(str);
96     return hek;
97 }
98
99 /* free the pool of temporary HE/HEK pairs returned by hv_fetch_ent
100  * for tied hashes */
101
102 void
103 Perl_free_tied_hv_pool(pTHX)
104 {
105     dVAR;
106     HE *he = PL_hv_fetch_ent_mh;
107     while (he) {
108         HE * const ohe = he;
109         Safefree(HeKEY_hek(he));
110         he = HeNEXT(he);
111         del_HE(ohe);
112     }
113     PL_hv_fetch_ent_mh = NULL;
114 }
115
116 #if defined(USE_ITHREADS)
117 HEK *
118 Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
119 {
120     HEK *shared;
121
122     PERL_ARGS_ASSERT_HEK_DUP;
123     PERL_UNUSED_ARG(param);
124
125     if (!source)
126         return NULL;
127
128     shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
129     if (shared) {
130         /* We already shared this hash key.  */
131         (void)share_hek_hek(shared);
132     }
133     else {
134         shared
135             = share_hek_flags(HEK_KEY(source), HEK_LEN(source),
136                               HEK_HASH(source), HEK_FLAGS(source));
137         ptr_table_store(PL_ptr_table, source, shared);
138     }
139     return shared;
140 }
141
142 HE *
143 Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
144 {
145     HE *ret;
146
147     PERL_ARGS_ASSERT_HE_DUP;
148
149     if (!e)
150         return NULL;
151     /* look for it in the table first */
152     ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
153     if (ret)
154         return ret;
155
156     /* create anew and remember what it is */
157     ret = new_HE();
158     ptr_table_store(PL_ptr_table, e, ret);
159
160     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
161     if (HeKLEN(e) == HEf_SVKEY) {
162         char *k;
163         Newx(k, HEK_BASESIZE + sizeof(const SV *), char);
164         HeKEY_hek(ret) = (HEK*)k;
165         HeKEY_sv(ret) = sv_dup_inc(HeKEY_sv(e), param);
166     }
167     else if (shared) {
168         /* This is hek_dup inlined, which seems to be important for speed
169            reasons.  */
170         HEK * const source = HeKEY_hek(e);
171         HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
172
173         if (shared) {
174             /* We already shared this hash key.  */
175             (void)share_hek_hek(shared);
176         }
177         else {
178             shared
179                 = share_hek_flags(HEK_KEY(source), HEK_LEN(source),
180                                   HEK_HASH(source), HEK_FLAGS(source));
181             ptr_table_store(PL_ptr_table, source, shared);
182         }
183         HeKEY_hek(ret) = shared;
184     }
185     else
186         HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
187                                         HeKFLAGS(e));
188     HeVAL(ret) = sv_dup_inc(HeVAL(e), param);
189     return ret;
190 }
191 #endif  /* USE_ITHREADS */
192
193 static void
194 S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
195                 const char *msg)
196 {
197     SV * const sv = sv_newmortal();
198
199     PERL_ARGS_ASSERT_HV_NOTALLOWED;
200
201     if (!(flags & HVhek_FREEKEY)) {
202         sv_setpvn(sv, key, klen);
203     }
204     else {
205         /* Need to free saved eventually assign to mortal SV */
206         /* XXX is this line an error ???:  SV *sv = sv_newmortal(); */
207         sv_usepvn(sv, (char *) key, klen);
208     }
209     if (flags & HVhek_UTF8) {
210         SvUTF8_on(sv);
211     }
212     Perl_croak(aTHX_ msg, SVfARG(sv));
213 }
214
215 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
216  * contains an SV* */
217
218 /*
219 =for apidoc hv_store
220
221 Stores an SV in a hash.  The hash key is specified as C<key> and the
222 absolute value of C<klen> is the length of the key.  If C<klen> is
223 negative the key is assumed to be in UTF-8-encoded Unicode.  The
224 C<hash> parameter is the precomputed hash value; if it is zero then
225 Perl will compute it.
226
227 The return value will be
228 NULL if the operation failed or if the value did not need to be actually
229 stored within the hash (as in the case of tied hashes).  Otherwise it can
230 be dereferenced to get the original C<SV*>.  Note that the caller is
231 responsible for suitably incrementing the reference count of C<val> before
232 the call, and decrementing it if the function returned NULL.  Effectively
233 a successful hv_store takes ownership of one reference to C<val>.  This is
234 usually what you want; a newly created SV has a reference count of one, so
235 if all your code does is create SVs then store them in a hash, hv_store
236 will own the only reference to the new SV, and your code doesn't need to do
237 anything further to tidy up.  hv_store is not implemented as a call to
238 hv_store_ent, and does not create a temporary SV for the key, so if your
239 key data is not already in SV form then use hv_store in preference to
240 hv_store_ent.
241
242 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
243 information on how to use this function on tied hashes.
244
245 =for apidoc hv_store_ent
246
247 Stores C<val> in a hash.  The hash key is specified as C<key>.  The C<hash>
248 parameter is the precomputed hash value; if it is zero then Perl will
249 compute it.  The return value is the new hash entry so created.  It will be
250 NULL if the operation failed or if the value did not need to be actually
251 stored within the hash (as in the case of tied hashes).  Otherwise the
252 contents of the return value can be accessed using the C<He?> macros
253 described here.  Note that the caller is responsible for suitably
254 incrementing the reference count of C<val> before the call, and
255 decrementing it if the function returned NULL.  Effectively a successful
256 hv_store_ent takes ownership of one reference to C<val>.  This is
257 usually what you want; a newly created SV has a reference count of one, so
258 if all your code does is create SVs then store them in a hash, hv_store
259 will own the only reference to the new SV, and your code doesn't need to do
260 anything further to tidy up.  Note that hv_store_ent only reads the C<key>;
261 unlike C<val> it does not take ownership of it, so maintaining the correct
262 reference count on C<key> is entirely the caller's responsibility.  hv_store
263 is not implemented as a call to hv_store_ent, and does not create a temporary
264 SV for the key, so if your key data is not already in SV form then use
265 hv_store in preference to hv_store_ent.
266
267 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
268 information on how to use this function on tied hashes.
269
270 =for apidoc hv_exists
271
272 Returns a boolean indicating whether the specified hash key exists.  The
273 absolute value of C<klen> is the length of the key.  If C<klen> is
274 negative the key is assumed to be in UTF-8-encoded Unicode.
275
276 =for apidoc hv_fetch
277
278 Returns the SV which corresponds to the specified key in the hash.
279 The absolute value of C<klen> is the length of the key.  If C<klen> is
280 negative the key is assumed to be in UTF-8-encoded Unicode.  If
281 C<lval> is set then the fetch will be part of a store.  This means that if
282 there is no value in the hash associated with the given key, then one is
283 created and a pointer to it is returned.  The C<SV*> it points to can be
284 assigned to.  But always check that the
285 return value is non-null before dereferencing it to an C<SV*>.
286
287 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
288 information on how to use this function on tied hashes.
289
290 =for apidoc hv_exists_ent
291
292 Returns a boolean indicating whether
293 the specified hash key exists.  C<hash>
294 can be a valid precomputed hash value, or 0 to ask for it to be
295 computed.
296
297 =cut
298 */
299
300 /* returns an HE * structure with the all fields set */
301 /* note that hent_val will be a mortal sv for MAGICAL hashes */
302 /*
303 =for apidoc hv_fetch_ent
304
305 Returns the hash entry which corresponds to the specified key in the hash.
306 C<hash> must be a valid precomputed hash number for the given C<key>, or 0
307 if you want the function to compute it.  IF C<lval> is set then the fetch
308 will be part of a store.  Make sure the return value is non-null before
309 accessing it.  The return value when C<hv> is a tied hash is a pointer to a
310 static location, so be sure to make a copy of the structure if you need to
311 store it somewhere.
312
313 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
314 information on how to use this function on tied hashes.
315
316 =cut
317 */
318
319 /* Common code for hv_delete()/hv_exists()/hv_fetch()/hv_store()  */
320 void *
321 Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32,
322                        const int action, SV *val, const U32 hash)
323 {
324     STRLEN klen;
325     int flags;
326
327     PERL_ARGS_ASSERT_HV_COMMON_KEY_LEN;
328
329     if (klen_i32 < 0) {
330         klen = -klen_i32;
331         flags = HVhek_UTF8;
332     } else {
333         klen = klen_i32;
334         flags = 0;
335     }
336     return hv_common(hv, NULL, key, klen, flags, action, val, hash);
337 }
338
339 void *
340 Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
341                int flags, int action, SV *val, U32 hash)
342 {
343     dVAR;
344     XPVHV* xhv;
345     HE *entry;
346     HE **oentry;
347     SV *sv;
348     bool is_utf8;
349     int masked_flags;
350     const int return_svp = action & HV_FETCH_JUST_SV;
351
352     if (!hv)
353         return NULL;
354     if (SvTYPE(hv) == (svtype)SVTYPEMASK)
355         return NULL;
356
357     assert(SvTYPE(hv) == SVt_PVHV);
358
359     if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) {
360         MAGIC* mg;
361         if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) {
362             struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
363             if (uf->uf_set == NULL) {
364                 SV* obj = mg->mg_obj;
365
366                 if (!keysv) {
367                     keysv = newSVpvn_flags(key, klen, SVs_TEMP |
368                                            ((flags & HVhek_UTF8)
369                                             ? SVf_UTF8 : 0));
370                 }
371                 
372                 mg->mg_obj = keysv;         /* pass key */
373                 uf->uf_index = action;      /* pass action */
374                 magic_getuvar(MUTABLE_SV(hv), mg);
375                 keysv = mg->mg_obj;         /* may have changed */
376                 mg->mg_obj = obj;
377
378                 /* If the key may have changed, then we need to invalidate
379                    any passed-in computed hash value.  */
380                 hash = 0;
381             }
382         }
383     }
384     if (keysv) {
385         if (flags & HVhek_FREEKEY)
386             Safefree(key);
387         key = SvPV_const(keysv, klen);
388         is_utf8 = (SvUTF8(keysv) != 0);
389         if (SvIsCOW_shared_hash(keysv)) {
390             flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
391         } else {
392             flags = is_utf8 ? HVhek_UTF8 : 0;
393         }
394     } else {
395         is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
396     }
397
398     if (action & HV_DELETE) {
399         return (void *) hv_delete_common(hv, keysv, key, klen,
400                                          flags, action, hash);
401     }
402
403     xhv = (XPVHV*)SvANY(hv);
404     if (SvMAGICAL(hv)) {
405         if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) {
406             if (mg_find((const SV *)hv, PERL_MAGIC_tied)
407                 || SvGMAGICAL((const SV *)hv))
408             {
409                 /* FIXME should be able to skimp on the HE/HEK here when
410                    HV_FETCH_JUST_SV is true.  */
411                 if (!keysv) {
412                     keysv = newSVpvn_utf8(key, klen, is_utf8);
413                 } else {
414                     keysv = newSVsv(keysv);
415                 }
416                 sv = sv_newmortal();
417                 mg_copy(MUTABLE_SV(hv), sv, (char *)keysv, HEf_SVKEY);
418
419                 /* grab a fake HE/HEK pair from the pool or make a new one */
420                 entry = PL_hv_fetch_ent_mh;
421                 if (entry)
422                     PL_hv_fetch_ent_mh = HeNEXT(entry);
423                 else {
424                     char *k;
425                     entry = new_HE();
426                     Newx(k, HEK_BASESIZE + sizeof(const SV *), char);
427                     HeKEY_hek(entry) = (HEK*)k;
428                 }
429                 HeNEXT(entry) = NULL;
430                 HeSVKEY_set(entry, keysv);
431                 HeVAL(entry) = sv;
432                 sv_upgrade(sv, SVt_PVLV);
433                 LvTYPE(sv) = 'T';
434                  /* so we can free entry when freeing sv */
435                 LvTARG(sv) = MUTABLE_SV(entry);
436
437                 /* XXX remove at some point? */
438                 if (flags & HVhek_FREEKEY)
439                     Safefree(key);
440
441                 if (return_svp) {
442                     return entry ? (void *) &HeVAL(entry) : NULL;
443                 }
444                 return (void *) entry;
445             }
446 #ifdef ENV_IS_CASELESS
447             else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
448                 U32 i;
449                 for (i = 0; i < klen; ++i)
450                     if (isLOWER(key[i])) {
451                         /* Would be nice if we had a routine to do the
452                            copy and upercase in a single pass through.  */
453                         const char * const nkey = strupr(savepvn(key,klen));
454                         /* Note that this fetch is for nkey (the uppercased
455                            key) whereas the store is for key (the original)  */
456                         void *result = hv_common(hv, NULL, nkey, klen,
457                                                  HVhek_FREEKEY, /* free nkey */
458                                                  0 /* non-LVAL fetch */
459                                                  | HV_DISABLE_UVAR_XKEY
460                                                  | return_svp,
461                                                  NULL /* no value */,
462                                                  0 /* compute hash */);
463                         if (!result && (action & HV_FETCH_LVALUE)) {
464                             /* This call will free key if necessary.
465                                Do it this way to encourage compiler to tail
466                                call optimise.  */
467                             result = hv_common(hv, keysv, key, klen, flags,
468                                                HV_FETCH_ISSTORE
469                                                | HV_DISABLE_UVAR_XKEY
470                                                | return_svp,
471                                                newSV(0), hash);
472                         } else {
473                             if (flags & HVhek_FREEKEY)
474                                 Safefree(key);
475                         }
476                         return result;
477                     }
478             }
479 #endif
480         } /* ISFETCH */
481         else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
482             if (mg_find((const SV *)hv, PERL_MAGIC_tied)
483                 || SvGMAGICAL((const SV *)hv)) {
484                 /* I don't understand why hv_exists_ent has svret and sv,
485                    whereas hv_exists only had one.  */
486                 SV * const svret = sv_newmortal();
487                 sv = sv_newmortal();
488
489                 if (keysv || is_utf8) {
490                     if (!keysv) {
491                         keysv = newSVpvn_utf8(key, klen, TRUE);
492                     } else {
493                         keysv = newSVsv(keysv);
494                     }
495                     mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY);
496                 } else {
497                     mg_copy(MUTABLE_SV(hv), sv, key, klen);
498                 }
499                 if (flags & HVhek_FREEKEY)
500                     Safefree(key);
501                 magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
502                 /* This cast somewhat evil, but I'm merely using NULL/
503                    not NULL to return the boolean exists.
504                    And I know hv is not NULL.  */
505                 return SvTRUE(svret) ? (void *)hv : NULL;
506                 }
507 #ifdef ENV_IS_CASELESS
508             else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
509                 /* XXX This code isn't UTF8 clean.  */
510                 char * const keysave = (char * const)key;
511                 /* Will need to free this, so set FREEKEY flag.  */
512                 key = savepvn(key,klen);
513                 key = (const char*)strupr((char*)key);
514                 is_utf8 = FALSE;
515                 hash = 0;
516                 keysv = 0;
517
518                 if (flags & HVhek_FREEKEY) {
519                     Safefree(keysave);
520                 }
521                 flags |= HVhek_FREEKEY;
522             }
523 #endif
524         } /* ISEXISTS */
525         else if (action & HV_FETCH_ISSTORE) {
526             bool needs_copy;
527             bool needs_store;
528             hv_magic_check (hv, &needs_copy, &needs_store);
529             if (needs_copy) {
530                 const bool save_taint = TAINT_get;
531                 if (keysv || is_utf8) {
532                     if (!keysv) {
533                         keysv = newSVpvn_utf8(key, klen, TRUE);
534                     }
535                     if (TAINTING_get)
536                         TAINT_set(SvTAINTED(keysv));
537                     keysv = sv_2mortal(newSVsv(keysv));
538                     mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY);
539                 } else {
540                     mg_copy(MUTABLE_SV(hv), val, key, klen);
541                 }
542
543                 TAINT_IF(save_taint);
544 #ifdef NO_TAINT_SUPPORT
545                 PERL_UNUSED_VAR(save_taint);
546 #endif
547                 if (!needs_store) {
548                     if (flags & HVhek_FREEKEY)
549                         Safefree(key);
550                     return NULL;
551                 }
552 #ifdef ENV_IS_CASELESS
553                 else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
554                     /* XXX This code isn't UTF8 clean.  */
555                     const char *keysave = key;
556                     /* Will need to free this, so set FREEKEY flag.  */
557                     key = savepvn(key,klen);
558                     key = (const char*)strupr((char*)key);
559                     is_utf8 = FALSE;
560                     hash = 0;
561                     keysv = 0;
562
563                     if (flags & HVhek_FREEKEY) {
564                         Safefree(keysave);
565                     }
566                     flags |= HVhek_FREEKEY;
567                 }
568 #endif
569             }
570         } /* ISSTORE */
571     } /* SvMAGICAL */
572
573     if (!HvARRAY(hv)) {
574         if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE))
575 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
576                  || (SvRMAGICAL((const SV *)hv)
577                      && mg_find((const SV *)hv, PERL_MAGIC_env))
578 #endif
579                                                                   ) {
580             char *array;
581             Newxz(array,
582                  PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
583                  char);
584             HvARRAY(hv) = (HE**)array;
585         }
586 #ifdef DYNAMIC_ENV_FETCH
587         else if (action & HV_FETCH_ISEXISTS) {
588             /* for an %ENV exists, if we do an insert it's by a recursive
589                store call, so avoid creating HvARRAY(hv) right now.  */
590         }
591 #endif
592         else {
593             /* XXX remove at some point? */
594             if (flags & HVhek_FREEKEY)
595                 Safefree(key);
596
597             return NULL;
598         }
599     }
600
601     if (is_utf8 && !(flags & HVhek_KEYCANONICAL)) {
602         char * const keysave = (char *)key;
603         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
604         if (is_utf8)
605             flags |= HVhek_UTF8;
606         else
607             flags &= ~HVhek_UTF8;
608         if (key != keysave) {
609             if (flags & HVhek_FREEKEY)
610                 Safefree(keysave);
611             flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
612             /* If the caller calculated a hash, it was on the sequence of
613                octets that are the UTF-8 form. We've now changed the sequence
614                of octets stored to that of the equivalent byte representation,
615                so the hash we need is different.  */
616             hash = 0;
617         }
618     }
619
620     if (!hash) {
621         if (keysv && (SvIsCOW_shared_hash(keysv)))
622             hash = SvSHARED_HASH(keysv);
623         else
624             PERL_HASH(hash, key, klen);
625     }
626
627     masked_flags = (flags & HVhek_MASK);
628
629 #ifdef DYNAMIC_ENV_FETCH
630     if (!HvARRAY(hv)) entry = NULL;
631     else
632 #endif
633     {
634         entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
635     }
636     for (; entry; entry = HeNEXT(entry)) {
637         if (HeHASH(entry) != hash)              /* strings can't be equal */
638             continue;
639         if (HeKLEN(entry) != (I32)klen)
640             continue;
641         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
642             continue;
643         if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
644             continue;
645
646         if (action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE)) {
647             if (HeKFLAGS(entry) != masked_flags) {
648                 /* We match if HVhek_UTF8 bit in our flags and hash key's
649                    match.  But if entry was set previously with HVhek_WASUTF8
650                    and key now doesn't (or vice versa) then we should change
651                    the key's flag, as this is assignment.  */
652                 if (HvSHAREKEYS(hv)) {
653                     /* Need to swap the key we have for a key with the flags we
654                        need. As keys are shared we can't just write to the
655                        flag, so we share the new one, unshare the old one.  */
656                     HEK * const new_hek = share_hek_flags(key, klen, hash,
657                                                    masked_flags);
658                     unshare_hek (HeKEY_hek(entry));
659                     HeKEY_hek(entry) = new_hek;
660                 }
661                 else if (hv == PL_strtab) {
662                     /* PL_strtab is usually the only hash without HvSHAREKEYS,
663                        so putting this test here is cheap  */
664                     if (flags & HVhek_FREEKEY)
665                         Safefree(key);
666                     Perl_croak(aTHX_ S_strtab_error,
667                                action & HV_FETCH_LVALUE ? "fetch" : "store");
668                 }
669                 else
670                     HeKFLAGS(entry) = masked_flags;
671                 if (masked_flags & HVhek_ENABLEHVKFLAGS)
672                     HvHASKFLAGS_on(hv);
673             }
674             if (HeVAL(entry) == &PL_sv_placeholder) {
675                 /* yes, can store into placeholder slot */
676                 if (action & HV_FETCH_LVALUE) {
677                     if (SvMAGICAL(hv)) {
678                         /* This preserves behaviour with the old hv_fetch
679                            implementation which at this point would bail out
680                            with a break; (at "if we find a placeholder, we
681                            pretend we haven't found anything")
682
683                            That break mean that if a placeholder were found, it
684                            caused a call into hv_store, which in turn would
685                            check magic, and if there is no magic end up pretty
686                            much back at this point (in hv_store's code).  */
687                         break;
688                     }
689                     /* LVAL fetch which actually needs a store.  */
690                     val = newSV(0);
691                     HvPLACEHOLDERS(hv)--;
692                 } else {
693                     /* store */
694                     if (val != &PL_sv_placeholder)
695                         HvPLACEHOLDERS(hv)--;
696                 }
697                 HeVAL(entry) = val;
698             } else if (action & HV_FETCH_ISSTORE) {
699                 SvREFCNT_dec(HeVAL(entry));
700                 HeVAL(entry) = val;
701             }
702         } else if (HeVAL(entry) == &PL_sv_placeholder) {
703             /* if we find a placeholder, we pretend we haven't found
704                anything */
705             break;
706         }
707         if (flags & HVhek_FREEKEY)
708             Safefree(key);
709         if (return_svp) {
710             return entry ? (void *) &HeVAL(entry) : NULL;
711         }
712         return entry;
713     }
714 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
715     if (!(action & HV_FETCH_ISSTORE) 
716         && SvRMAGICAL((const SV *)hv)
717         && mg_find((const SV *)hv, PERL_MAGIC_env)) {
718         unsigned long len;
719         const char * const env = PerlEnv_ENVgetenv_len(key,&len);
720         if (env) {
721             sv = newSVpvn(env,len);
722             SvTAINTED_on(sv);
723             return hv_common(hv, keysv, key, klen, flags,
724                              HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp,
725                              sv, hash);
726         }
727     }
728 #endif
729
730     if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
731         hv_notallowed(flags, key, klen,
732                         "Attempt to access disallowed key '%"SVf"' in"
733                         " a restricted hash");
734     }
735     if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) {
736         /* Not doing some form of store, so return failure.  */
737         if (flags & HVhek_FREEKEY)
738             Safefree(key);
739         return NULL;
740     }
741     if (action & HV_FETCH_LVALUE) {
742         val = action & HV_FETCH_EMPTY_HE ? NULL : newSV(0);
743         if (SvMAGICAL(hv)) {
744             /* At this point the old hv_fetch code would call to hv_store,
745                which in turn might do some tied magic. So we need to make that
746                magic check happen.  */
747             /* gonna assign to this, so it better be there */
748             /* If a fetch-as-store fails on the fetch, then the action is to
749                recurse once into "hv_store". If we didn't do this, then that
750                recursive call would call the key conversion routine again.
751                However, as we replace the original key with the converted
752                key, this would result in a double conversion, which would show
753                up as a bug if the conversion routine is not idempotent.
754                Hence the use of HV_DISABLE_UVAR_XKEY.  */
755             return hv_common(hv, keysv, key, klen, flags,
756                              HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp,
757                              val, hash);
758             /* XXX Surely that could leak if the fetch-was-store fails?
759                Just like the hv_fetch.  */
760         }
761     }
762
763     /* Welcome to hv_store...  */
764
765     if (!HvARRAY(hv)) {
766         /* Not sure if we can get here.  I think the only case of oentry being
767            NULL is for %ENV with dynamic env fetch.  But that should disappear
768            with magic in the previous code.  */
769         char *array;
770         Newxz(array,
771              PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
772              char);
773         HvARRAY(hv) = (HE**)array;
774     }
775
776     oentry = &(HvARRAY(hv))[hash & (I32) xhv->xhv_max];
777
778     entry = new_HE();
779     /* share_hek_flags will do the free for us.  This might be considered
780        bad API design.  */
781     if (HvSHAREKEYS(hv))
782         HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
783     else if (hv == PL_strtab) {
784         /* PL_strtab is usually the only hash without HvSHAREKEYS, so putting
785            this test here is cheap  */
786         if (flags & HVhek_FREEKEY)
787             Safefree(key);
788         Perl_croak(aTHX_ S_strtab_error,
789                    action & HV_FETCH_LVALUE ? "fetch" : "store");
790     }
791     else                                       /* gotta do the real thing */
792         HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
793     HeVAL(entry) = val;
794
795     if (!*oentry && SvOOK(hv)) {
796         /* initial entry, and aux struct present.  */
797         struct xpvhv_aux *const aux = HvAUX(hv);
798         if (aux->xhv_fill_lazy)
799             ++aux->xhv_fill_lazy;
800     }
801
802 #ifdef PERL_HASH_RANDOMIZE_KEYS
803     /* This logic semi-randomizes the insert order in a bucket.
804      * Either we insert into the top, or the slot below the top,
805      * making it harder to see if there is a collision. We also
806      * reset the iterator randomizer if there is one.
807      */
808     if ( *oentry && PL_HASH_RAND_BITS_ENABLED) {
809         PL_hash_rand_bits++;
810         PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1);
811         if ( PL_hash_rand_bits & 1 ) {
812             HeNEXT(entry) = HeNEXT(*oentry);
813             HeNEXT(*oentry) = entry;
814         } else {
815             HeNEXT(entry) = *oentry;
816             *oentry = entry;
817         }
818     } else
819 #endif
820     {
821         HeNEXT(entry) = *oentry;
822         *oentry = entry;
823     }
824 #ifdef PERL_HASH_RANDOMIZE_KEYS
825     if (SvOOK(hv)) {
826         /* Currently this makes various tests warn in annoying ways.
827          * So Silenced for now. - Yves | bogus end of comment =>* /
828         if (HvAUX(hv)->xhv_riter != -1) {
829             Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
830                              "[TESTING] Inserting into a hash during each() traversal results in undefined behavior"
831                              pTHX__FORMAT
832                              pTHX__VALUE);
833         }
834         */
835         if (PL_HASH_RAND_BITS_ENABLED) {
836             if (PL_HASH_RAND_BITS_ENABLED == 1)
837                 PL_hash_rand_bits += (PTRV)entry + 1;  /* we don't bother to use ptr_hash here */
838             PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1);
839         }
840         HvAUX(hv)->xhv_rand= (U32)PL_hash_rand_bits;
841     }
842 #endif
843
844     if (val == &PL_sv_placeholder)
845         HvPLACEHOLDERS(hv)++;
846     if (masked_flags & HVhek_ENABLEHVKFLAGS)
847         HvHASKFLAGS_on(hv);
848
849     xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
850     if ( DO_HSPLIT(xhv) ) {
851         const STRLEN oldsize = xhv->xhv_max + 1;
852         const U32 items = (U32)HvPLACEHOLDERS_get(hv);
853
854         if (items /* hash has placeholders  */
855             && !SvREADONLY(hv) /* but is not a restricted hash */) {
856             /* If this hash previously was a "restricted hash" and had
857                placeholders, but the "restricted" flag has been turned off,
858                then the placeholders no longer serve any useful purpose.
859                However, they have the downsides of taking up RAM, and adding
860                extra steps when finding used values. It's safe to clear them
861                at this point, even though Storable rebuilds restricted hashes by
862                putting in all the placeholders (first) before turning on the
863                readonly flag, because Storable always pre-splits the hash.
864                If we're lucky, then we may clear sufficient placeholders to
865                avoid needing to split the hash at all.  */
866             clear_placeholders(hv, items);
867             if (DO_HSPLIT(xhv))
868                 hsplit(hv, oldsize, oldsize * 2);
869         } else
870             hsplit(hv, oldsize, oldsize * 2);
871     }
872
873     if (return_svp) {
874         return entry ? (void *) &HeVAL(entry) : NULL;
875     }
876     return (void *) entry;
877 }
878
879 STATIC void
880 S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store)
881 {
882     const MAGIC *mg = SvMAGIC(hv);
883
884     PERL_ARGS_ASSERT_HV_MAGIC_CHECK;
885
886     *needs_copy = FALSE;
887     *needs_store = TRUE;
888     while (mg) {
889         if (isUPPER(mg->mg_type)) {
890             *needs_copy = TRUE;
891             if (mg->mg_type == PERL_MAGIC_tied) {
892                 *needs_store = FALSE;
893                 return; /* We've set all there is to set. */
894             }
895         }
896         mg = mg->mg_moremagic;
897     }
898 }
899
900 /*
901 =for apidoc hv_scalar
902
903 Evaluates the hash in scalar context and returns the result.  Handles magic
904 when the hash is tied.
905
906 =cut
907 */
908
909 SV *
910 Perl_hv_scalar(pTHX_ HV *hv)
911 {
912     SV *sv;
913
914     PERL_ARGS_ASSERT_HV_SCALAR;
915
916     if (SvRMAGICAL(hv)) {
917         MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied);
918         if (mg)
919             return magic_scalarpack(hv, mg);
920     }
921
922     sv = sv_newmortal();
923     if (HvTOTALKEYS((const HV *)hv)) 
924         Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
925                 (long)HvFILL(hv), (long)HvMAX(hv) + 1);
926     else
927         sv_setiv(sv, 0);
928     
929     return sv;
930 }
931
932 /*
933 =for apidoc hv_delete
934
935 Deletes a key/value pair in the hash.  The value's SV is removed from
936 the hash, made mortal, and returned to the caller.  The absolute
937 value of C<klen> is the length of the key.  If C<klen> is negative the
938 key is assumed to be in UTF-8-encoded Unicode.  The C<flags> value
939 will normally be zero; if set to G_DISCARD then NULL will be returned.
940 NULL will also be returned if the key is not found.
941
942 =for apidoc hv_delete_ent
943
944 Deletes a key/value pair in the hash.  The value SV is removed from the hash,
945 made mortal, and returned to the caller.  The C<flags> value will normally be
946 zero; if set to G_DISCARD then NULL will be returned.  NULL will also be
947 returned if the key is not found.  C<hash> can be a valid precomputed hash
948 value, or 0 to ask for it to be computed.
949
950 =cut
951 */
952
953 STATIC SV *
954 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
955                    int k_flags, I32 d_flags, U32 hash)
956 {
957     dVAR;
958     XPVHV* xhv;
959     HE *entry;
960     HE **oentry;
961     HE *const *first_entry;
962     bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
963     int masked_flags;
964
965     if (SvRMAGICAL(hv)) {
966         bool needs_copy;
967         bool needs_store;
968         hv_magic_check (hv, &needs_copy, &needs_store);
969
970         if (needs_copy) {
971             SV *sv;
972             entry = (HE *) hv_common(hv, keysv, key, klen,
973                                      k_flags & ~HVhek_FREEKEY,
974                                      HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY,
975                                      NULL, hash);
976             sv = entry ? HeVAL(entry) : NULL;
977             if (sv) {
978                 if (SvMAGICAL(sv)) {
979                     mg_clear(sv);
980                 }
981                 if (!needs_store) {
982                     if (mg_find(sv, PERL_MAGIC_tiedelem)) {
983                         /* No longer an element */
984                         sv_unmagic(sv, PERL_MAGIC_tiedelem);
985                         return sv;
986                     }           
987                     return NULL;                /* element cannot be deleted */
988                 }
989 #ifdef ENV_IS_CASELESS
990                 else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
991                     /* XXX This code isn't UTF8 clean.  */
992                     keysv = newSVpvn_flags(key, klen, SVs_TEMP);
993                     if (k_flags & HVhek_FREEKEY) {
994                         Safefree(key);
995                     }
996                     key = strupr(SvPVX(keysv));
997                     is_utf8 = 0;
998                     k_flags = 0;
999                     hash = 0;
1000                 }
1001 #endif
1002             }
1003         }
1004     }
1005     xhv = (XPVHV*)SvANY(hv);
1006     if (!HvARRAY(hv))
1007         return NULL;
1008
1009     if (is_utf8 && !(k_flags & HVhek_KEYCANONICAL)) {
1010         const char * const keysave = key;
1011         key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
1012
1013         if (is_utf8)
1014             k_flags |= HVhek_UTF8;
1015         else
1016             k_flags &= ~HVhek_UTF8;
1017         if (key != keysave) {
1018             if (k_flags & HVhek_FREEKEY) {
1019                 /* This shouldn't happen if our caller does what we expect,
1020                    but strictly the API allows it.  */
1021                 Safefree(keysave);
1022             }
1023             k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
1024         }
1025         HvHASKFLAGS_on(MUTABLE_SV(hv));
1026     }
1027
1028     if (!hash) {
1029         if (keysv && (SvIsCOW_shared_hash(keysv)))
1030             hash = SvSHARED_HASH(keysv);
1031         else
1032             PERL_HASH(hash, key, klen);
1033     }
1034
1035     masked_flags = (k_flags & HVhek_MASK);
1036
1037     first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
1038     entry = *oentry;
1039     for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
1040         SV *sv;
1041         U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
1042         GV *gv = NULL;
1043         HV *stash = NULL;
1044
1045         if (HeHASH(entry) != hash)              /* strings can't be equal */
1046             continue;
1047         if (HeKLEN(entry) != (I32)klen)
1048             continue;
1049         if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
1050             continue;
1051         if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
1052             continue;
1053
1054         if (hv == PL_strtab) {
1055             if (k_flags & HVhek_FREEKEY)
1056                 Safefree(key);
1057             Perl_croak(aTHX_ S_strtab_error, "delete");
1058         }
1059
1060         /* if placeholder is here, it's already been deleted.... */
1061         if (HeVAL(entry) == &PL_sv_placeholder) {
1062             if (k_flags & HVhek_FREEKEY)
1063                 Safefree(key);
1064             return NULL;
1065         }
1066         if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
1067             hv_notallowed(k_flags, key, klen,
1068                             "Attempt to delete readonly key '%"SVf"' from"
1069                             " a restricted hash");
1070         }
1071         if (k_flags & HVhek_FREEKEY)
1072             Safefree(key);
1073
1074         /* If this is a stash and the key ends with ::, then someone is 
1075          * deleting a package.
1076          */
1077         if (HeVAL(entry) && HvENAME_get(hv)) {
1078                 gv = (GV *)HeVAL(entry);
1079                 if (keysv) key = SvPV(keysv, klen);
1080                 if ((
1081                      (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':')
1082                       ||
1083                      (klen == 1 && key[0] == ':')
1084                     )
1085                  && (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6))
1086                  && SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv))
1087                  && HvENAME_get(stash)) {
1088                         /* A previous version of this code checked that the
1089                          * GV was still in the symbol table by fetching the
1090                          * GV with its name. That is not necessary (and
1091                          * sometimes incorrect), as HvENAME cannot be set
1092                          * on hv if it is not in the symtab. */
1093                         mro_changes = 2;
1094                         /* Hang on to it for a bit. */
1095                         SvREFCNT_inc_simple_void_NN(
1096                          sv_2mortal((SV *)gv)
1097                         );
1098                 }
1099                 else if (klen == 3 && strnEQ(key, "ISA", 3))
1100                     mro_changes = 1;
1101         }
1102
1103         sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry));
1104         HeVAL(entry) = &PL_sv_placeholder;
1105         if (sv) {
1106             /* deletion of method from stash */
1107             if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
1108              && HvENAME_get(hv))
1109                 mro_method_changed_in(hv);
1110         }
1111
1112         /*
1113          * If a restricted hash, rather than really deleting the entry, put
1114          * a placeholder there. This marks the key as being "approved", so
1115          * we can still access via not-really-existing key without raising
1116          * an error.
1117          */
1118         if (SvREADONLY(hv))
1119             /* We'll be saving this slot, so the number of allocated keys
1120              * doesn't go down, but the number placeholders goes up */
1121             HvPLACEHOLDERS(hv)++;
1122         else {
1123             *oentry = HeNEXT(entry);
1124             if(!*first_entry && SvOOK(hv)) {
1125                 /* removed last entry, and aux struct present.  */
1126                 struct xpvhv_aux *const aux = HvAUX(hv);
1127                 if (aux->xhv_fill_lazy)
1128                     --aux->xhv_fill_lazy;
1129             }
1130             if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
1131                 HvLAZYDEL_on(hv);
1132             else {
1133                 if (SvOOK(hv) && HvLAZYDEL(hv) &&
1134                     entry == HeNEXT(HvAUX(hv)->xhv_eiter))
1135                     HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
1136                 hv_free_ent(hv, entry);
1137             }
1138             xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
1139             if (xhv->xhv_keys == 0)
1140                 HvHASKFLAGS_off(hv);
1141         }
1142
1143         if (d_flags & G_DISCARD) {
1144             SvREFCNT_dec(sv);
1145             sv = NULL;
1146         }
1147
1148         if (mro_changes == 1) mro_isa_changed_in(hv);
1149         else if (mro_changes == 2)
1150             mro_package_moved(NULL, stash, gv, 1);
1151
1152         return sv;
1153     }
1154     if (SvREADONLY(hv)) {
1155         hv_notallowed(k_flags, key, klen,
1156                         "Attempt to delete disallowed key '%"SVf"' from"
1157                         " a restricted hash");
1158     }
1159
1160     if (k_flags & HVhek_FREEKEY)
1161         Safefree(key);
1162     return NULL;
1163 }
1164
1165
1166 STATIC void
1167 S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize)
1168 {
1169     dVAR;
1170     STRLEN i = 0;
1171     char *a = (char*) HvARRAY(hv);
1172     HE **aep;
1173
1174     bool do_aux= (
1175         /* already have an HvAUX(hv) so we have to move it */
1176         SvOOK(hv) ||
1177         /* no HvAUX() but array we are going to allocate is large enough
1178          * there is no point in saving the space for the iterator, and
1179          * speeds up later traversals. */
1180         ( ( hv != PL_strtab ) && ( newsize >= PERL_HV_ALLOC_AUX_SIZE ) )
1181     );
1182
1183     PERL_ARGS_ASSERT_HSPLIT;
1184
1185     PL_nomemok = TRUE;
1186     Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
1187           + (do_aux ? sizeof(struct xpvhv_aux) : 0), char);
1188     PL_nomemok = FALSE;
1189     if (!a) {
1190       return;
1191     }
1192
1193 #ifdef PERL_HASH_RANDOMIZE_KEYS
1194     /* the idea of this is that we create a "random" value by hashing the address of
1195      * the array, we then use the low bit to decide if we insert at the top, or insert
1196      * second from top. After each such insert we rotate the hashed value. So we can
1197      * use the same hashed value over and over, and in normal build environments use
1198      * very few ops to do so. ROTL32() should produce a single machine operation. */
1199     if (PL_HASH_RAND_BITS_ENABLED) {
1200         if (PL_HASH_RAND_BITS_ENABLED == 1)
1201             PL_hash_rand_bits += ptr_hash((PTRV)a);
1202         PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,1);
1203     }
1204 #endif
1205     HvARRAY(hv) = (HE**) a;
1206     HvMAX(hv) = newsize - 1;
1207     /* before we zero the newly added memory, we
1208      * need to deal with the aux struct that may be there
1209      * or have been allocated by us*/
1210     if (do_aux) {
1211         struct xpvhv_aux *const dest
1212             = (struct xpvhv_aux*) &a[newsize * sizeof(HE*)];
1213         if (SvOOK(hv)) {
1214             /* alread have an aux, copy the old one in place. */
1215             Move(&a[oldsize * sizeof(HE*)], dest, 1, struct xpvhv_aux);
1216             /* we reset the iterator's xhv_rand as well, so they get a totally new ordering */
1217 #ifdef PERL_HASH_RANDOMIZE_KEYS
1218             dest->xhv_rand = (U32)PL_hash_rand_bits;
1219 #endif
1220             /* For now, just reset the lazy fill counter.
1221                It would be possible to update the counter in the code below
1222                instead.  */
1223             dest->xhv_fill_lazy = 0;
1224         } else {
1225             /* no existing aux structure, but we allocated space for one
1226              * so intialize it properly. This unrolls hv_auxinit() a bit,
1227              * since we have to do the realloc anyway. */
1228             /* first we set the iterator's xhv_rand so it can be copied into lastrand below */
1229 #ifdef PERL_HASH_RANDOMIZE_KEYS
1230             dest->xhv_rand = (U32)PL_hash_rand_bits;
1231 #endif
1232             /* this is the "non realloc" part of the hv_auxinit() */
1233             (void)hv_auxinit_internal(dest);
1234             /* Turn on the OOK flag */
1235             SvOOK_on(hv);
1236         }
1237     }
1238     /* now we can safely clear the second half */
1239     Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);     /* zero 2nd half*/
1240
1241     if (!HvTOTALKEYS(hv))       /* skip rest if no entries */
1242         return;
1243
1244     newsize--;
1245     aep = (HE**)a;
1246     do {
1247         HE **oentry = aep + i;
1248         HE *entry = aep[i];
1249
1250         if (!entry)                             /* non-existent */
1251             continue;
1252         do {
1253             U32 j = (HeHASH(entry) & newsize);
1254             if (j != (U32)i) {
1255                 *oentry = HeNEXT(entry);
1256 #ifdef PERL_HASH_RANDOMIZE_KEYS
1257                 /* if the target cell is empty or PL_HASH_RAND_BITS_ENABLED is false
1258                  * insert to top, otherwise rotate the bucket rand 1 bit,
1259                  * and use the new low bit to decide if we insert at top,
1260                  * or next from top. IOW, we only rotate on a collision.*/
1261                 if (aep[j] && PL_HASH_RAND_BITS_ENABLED) {
1262                     PL_hash_rand_bits+= ROTL_UV(HeHASH(entry), 17);
1263                     PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1);
1264                     if (PL_hash_rand_bits & 1) {
1265                         HeNEXT(entry)= HeNEXT(aep[j]);
1266                         HeNEXT(aep[j])= entry;
1267                     } else {
1268                         /* Note, this is structured in such a way as the optimizer
1269                         * should eliminate the duplicated code here and below without
1270                         * us needing to explicitly use a goto. */
1271                         HeNEXT(entry) = aep[j];
1272                         aep[j] = entry;
1273                     }
1274                 } else
1275 #endif
1276                 {
1277                     /* see comment above about duplicated code */
1278                     HeNEXT(entry) = aep[j];
1279                     aep[j] = entry;
1280                 }
1281             }
1282             else {
1283                 oentry = &HeNEXT(entry);
1284             }
1285             entry = *oentry;
1286         } while (entry);
1287     } while (i++ < oldsize);
1288 }
1289
1290 void
1291 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
1292 {
1293     dVAR;
1294     XPVHV* xhv = (XPVHV*)SvANY(hv);
1295     const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
1296     I32 newsize;
1297     char *a;
1298
1299     PERL_ARGS_ASSERT_HV_KSPLIT;
1300
1301     newsize = (I32) newmax;                     /* possible truncation here */
1302     if (newsize != newmax || newmax <= oldsize)
1303         return;
1304     while ((newsize & (1 + ~newsize)) != newsize) {
1305         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
1306     }
1307     if (newsize < newmax)
1308         newsize *= 2;
1309     if (newsize < newmax)
1310         return;                                 /* overflow detection */
1311
1312     a = (char *) HvARRAY(hv);
1313     if (a) {
1314         hsplit(hv, oldsize, newsize);
1315     } else {
1316         Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
1317         xhv->xhv_max = --newsize;
1318         HvARRAY(hv) = (HE **) a;
1319     }
1320 }
1321
1322 /* IMO this should also handle cases where hv_max is smaller than hv_keys
1323  * as tied hashes could play silly buggers and mess us around. We will
1324  * do the right thing during hv_store() afterwards, but still - Yves */
1325 #define HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys) STMT_START {\
1326     /* Can we use fewer buckets? (hv_max is always 2^n-1) */        \
1327     if (hv_max < PERL_HASH_DEFAULT_HvMAX) {                         \
1328         hv_max = PERL_HASH_DEFAULT_HvMAX;                           \
1329     } else {                                                        \
1330         while (hv_max > PERL_HASH_DEFAULT_HvMAX && hv_max + 1 >= hv_keys * 2) \
1331             hv_max = hv_max / 2;                                    \
1332     }                                                               \
1333     HvMAX(hv) = hv_max;                                             \
1334 } STMT_END
1335
1336
1337 HV *
1338 Perl_newHVhv(pTHX_ HV *ohv)
1339 {
1340     dVAR;
1341     HV * const hv = newHV();
1342     STRLEN hv_max;
1343
1344     if (!ohv || (!HvTOTALKEYS(ohv) && !SvMAGICAL((const SV *)ohv)))
1345         return hv;
1346     hv_max = HvMAX(ohv);
1347
1348     if (!SvMAGICAL((const SV *)ohv)) {
1349         /* It's an ordinary hash, so copy it fast. AMS 20010804 */
1350         STRLEN i;
1351         const bool shared = !!HvSHAREKEYS(ohv);
1352         HE **ents, ** const oents = (HE **)HvARRAY(ohv);
1353         char *a;
1354         Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
1355         ents = (HE**)a;
1356
1357         /* In each bucket... */
1358         for (i = 0; i <= hv_max; i++) {
1359             HE *prev = NULL;
1360             HE *oent = oents[i];
1361
1362             if (!oent) {
1363                 ents[i] = NULL;
1364                 continue;
1365             }
1366
1367             /* Copy the linked list of entries. */
1368             for (; oent; oent = HeNEXT(oent)) {
1369                 const U32 hash   = HeHASH(oent);
1370                 const char * const key = HeKEY(oent);
1371                 const STRLEN len = HeKLEN(oent);
1372                 const int flags  = HeKFLAGS(oent);
1373                 HE * const ent   = new_HE();
1374                 SV *const val    = HeVAL(oent);
1375
1376                 HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val);
1377                 HeKEY_hek(ent)
1378                     = shared ? share_hek_flags(key, len, hash, flags)
1379                              :  save_hek_flags(key, len, hash, flags);
1380                 if (prev)
1381                     HeNEXT(prev) = ent;
1382                 else
1383                     ents[i] = ent;
1384                 prev = ent;
1385                 HeNEXT(ent) = NULL;
1386             }
1387         }
1388
1389         HvMAX(hv)   = hv_max;
1390         HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
1391         HvARRAY(hv) = ents;
1392     } /* not magical */
1393     else {
1394         /* Iterate over ohv, copying keys and values one at a time. */
1395         HE *entry;
1396         const I32 riter = HvRITER_get(ohv);
1397         HE * const eiter = HvEITER_get(ohv);
1398         STRLEN hv_keys = HvTOTALKEYS(ohv);
1399
1400         HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys);
1401
1402         hv_iterinit(ohv);
1403         while ((entry = hv_iternext_flags(ohv, 0))) {
1404             SV *val = hv_iterval(ohv,entry);
1405             SV * const keysv = HeSVKEY(entry);
1406             val = SvIMMORTAL(val) ? val : newSVsv(val);
1407             if (keysv)
1408                 (void)hv_store_ent(hv, keysv, val, 0);
1409             else
1410                 (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), val,
1411                                  HeHASH(entry), HeKFLAGS(entry));
1412         }
1413         HvRITER_set(ohv, riter);
1414         HvEITER_set(ohv, eiter);
1415     }
1416
1417     return hv;
1418 }
1419
1420 /*
1421 =for apidoc Am|HV *|hv_copy_hints_hv|HV *ohv
1422
1423 A specialised version of L</newHVhv> for copying C<%^H>.  I<ohv> must be
1424 a pointer to a hash (which may have C<%^H> magic, but should be generally
1425 non-magical), or C<NULL> (interpreted as an empty hash).  The content
1426 of I<ohv> is copied to a new hash, which has the C<%^H>-specific magic
1427 added to it.  A pointer to the new hash is returned.
1428
1429 =cut
1430 */
1431
1432 HV *
1433 Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
1434 {
1435     HV * const hv = newHV();
1436
1437     if (ohv) {
1438         STRLEN hv_max = HvMAX(ohv);
1439         STRLEN hv_keys = HvTOTALKEYS(ohv);
1440         HE *entry;
1441         const I32 riter = HvRITER_get(ohv);
1442         HE * const eiter = HvEITER_get(ohv);
1443
1444         ENTER;
1445         SAVEFREESV(hv);
1446
1447         HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys);
1448
1449         hv_iterinit(ohv);
1450         while ((entry = hv_iternext_flags(ohv, 0))) {
1451             SV *const sv = newSVsv(hv_iterval(ohv,entry));
1452             SV *heksv = HeSVKEY(entry);
1453             if (!heksv && sv) heksv = newSVhek(HeKEY_hek(entry));
1454             if (sv) sv_magic(sv, NULL, PERL_MAGIC_hintselem,
1455                      (char *)heksv, HEf_SVKEY);
1456             if (heksv == HeSVKEY(entry))
1457                 (void)hv_store_ent(hv, heksv, sv, 0);
1458             else {
1459                 (void)hv_common(hv, heksv, HeKEY(entry), HeKLEN(entry),
1460                                  HeKFLAGS(entry), HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, sv, HeHASH(entry));
1461                 SvREFCNT_dec_NN(heksv);
1462             }
1463         }
1464         HvRITER_set(ohv, riter);
1465         HvEITER_set(ohv, eiter);
1466
1467         SvREFCNT_inc_simple_void_NN(hv);
1468         LEAVE;
1469     }
1470     hv_magic(hv, NULL, PERL_MAGIC_hints);
1471     return hv;
1472 }
1473 #undef HV_SET_MAX_ADJUSTED_FOR_KEYS
1474
1475 /* like hv_free_ent, but returns the SV rather than freeing it */
1476 STATIC SV*
1477 S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry)
1478 {
1479     dVAR;
1480     SV *val;
1481
1482     PERL_ARGS_ASSERT_HV_FREE_ENT_RET;
1483
1484     val = HeVAL(entry);
1485     if (HeKLEN(entry) == HEf_SVKEY) {
1486         SvREFCNT_dec(HeKEY_sv(entry));
1487         Safefree(HeKEY_hek(entry));
1488     }
1489     else if (HvSHAREKEYS(hv))
1490         unshare_hek(HeKEY_hek(entry));
1491     else
1492         Safefree(HeKEY_hek(entry));
1493     del_HE(entry);
1494     return val;
1495 }
1496
1497
1498 void
1499 Perl_hv_free_ent(pTHX_ HV *hv, HE *entry)
1500 {
1501     dVAR;
1502     SV *val;
1503
1504     PERL_ARGS_ASSERT_HV_FREE_ENT;
1505
1506     if (!entry)
1507         return;
1508     val = hv_free_ent_ret(hv, entry);
1509     SvREFCNT_dec(val);
1510 }
1511
1512
1513 void
1514 Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry)
1515 {
1516     dVAR;
1517
1518     PERL_ARGS_ASSERT_HV_DELAYFREE_ENT;
1519
1520     if (!entry)
1521         return;
1522     /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent  */
1523     sv_2mortal(SvREFCNT_inc(HeVAL(entry)));     /* free between statements */
1524     if (HeKLEN(entry) == HEf_SVKEY) {
1525         sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry)));
1526     }
1527     hv_free_ent(hv, entry);
1528 }
1529
1530 /*
1531 =for apidoc hv_clear
1532
1533 Frees the all the elements of a hash, leaving it empty.
1534 The XS equivalent of C<%hash = ()>.  See also L</hv_undef>.
1535
1536 If any destructors are triggered as a result, the hv itself may
1537 be freed.
1538
1539 =cut
1540 */
1541
1542 void
1543 Perl_hv_clear(pTHX_ HV *hv)
1544 {
1545     dVAR;
1546     XPVHV* xhv;
1547     if (!hv)
1548         return;
1549
1550     DEBUG_A(Perl_hv_assert(aTHX_ hv));
1551
1552     xhv = (XPVHV*)SvANY(hv);
1553
1554     ENTER;
1555     SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
1556     if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
1557         /* restricted hash: convert all keys to placeholders */
1558         STRLEN i;
1559         for (i = 0; i <= xhv->xhv_max; i++) {
1560             HE *entry = (HvARRAY(hv))[i];
1561             for (; entry; entry = HeNEXT(entry)) {
1562                 /* not already placeholder */
1563                 if (HeVAL(entry) != &PL_sv_placeholder) {
1564                     if (HeVAL(entry)) {
1565                         if (SvREADONLY(HeVAL(entry))) {
1566                             SV* const keysv = hv_iterkeysv(entry);
1567                             Perl_croak_nocontext(
1568                                 "Attempt to delete readonly key '%"SVf"' from a restricted hash",
1569                                 (void*)keysv);
1570                         }
1571                         SvREFCNT_dec_NN(HeVAL(entry));
1572                     }
1573                     HeVAL(entry) = &PL_sv_placeholder;
1574                     HvPLACEHOLDERS(hv)++;
1575                 }
1576             }
1577         }
1578     }
1579     else {
1580         hfreeentries(hv);
1581         HvPLACEHOLDERS_set(hv, 0);
1582
1583         if (SvRMAGICAL(hv))
1584             mg_clear(MUTABLE_SV(hv));
1585
1586         HvHASKFLAGS_off(hv);
1587     }
1588     if (SvOOK(hv)) {
1589         if(HvENAME_get(hv))
1590             mro_isa_changed_in(hv);
1591         HvEITER_set(hv, NULL);
1592     }
1593     LEAVE;
1594 }
1595
1596 /*
1597 =for apidoc hv_clear_placeholders
1598
1599 Clears any placeholders from a hash.  If a restricted hash has any of its keys
1600 marked as readonly and the key is subsequently deleted, the key is not actually
1601 deleted but is marked by assigning it a value of &PL_sv_placeholder.  This tags
1602 it so it will be ignored by future operations such as iterating over the hash,
1603 but will still allow the hash to have a value reassigned to the key at some
1604 future point.  This function clears any such placeholder keys from the hash.
1605 See Hash::Util::lock_keys() for an example of its use.
1606
1607 =cut
1608 */
1609
1610 void
1611 Perl_hv_clear_placeholders(pTHX_ HV *hv)
1612 {
1613     dVAR;
1614     const U32 items = (U32)HvPLACEHOLDERS_get(hv);
1615
1616     PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS;
1617
1618     if (items)
1619         clear_placeholders(hv, items);
1620 }
1621
1622 static void
1623 S_clear_placeholders(pTHX_ HV *hv, U32 items)
1624 {
1625     dVAR;
1626     I32 i;
1627
1628     PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
1629
1630     if (items == 0)
1631         return;
1632
1633     i = HvMAX(hv);
1634     do {
1635         /* Loop down the linked list heads  */
1636         HE **oentry = &(HvARRAY(hv))[i];
1637         HE *entry;
1638
1639         while ((entry = *oentry)) {
1640             if (HeVAL(entry) == &PL_sv_placeholder) {
1641                 *oentry = HeNEXT(entry);
1642                 if (entry == HvEITER_get(hv))
1643                     HvLAZYDEL_on(hv);
1644                 else {
1645                     if (SvOOK(hv) && HvLAZYDEL(hv) &&
1646                         entry == HeNEXT(HvAUX(hv)->xhv_eiter))
1647                         HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
1648                     hv_free_ent(hv, entry);
1649                 }
1650
1651                 if (--items == 0) {
1652                     /* Finished.  */
1653                     I32 placeholders = HvPLACEHOLDERS_get(hv);
1654                     HvTOTALKEYS(hv) -= (IV)placeholders;
1655                     /* HvUSEDKEYS expanded */
1656                     if ((HvTOTALKEYS(hv) - placeholders) == 0)
1657                         HvHASKFLAGS_off(hv);
1658                     HvPLACEHOLDERS_set(hv, 0);
1659                     return;
1660                 }
1661             } else {
1662                 oentry = &HeNEXT(entry);
1663             }
1664         }
1665     } while (--i >= 0);
1666     /* You can't get here, hence assertion should always fail.  */
1667     assert (items == 0);
1668     NOT_REACHED;
1669 }
1670
1671 STATIC void
1672 S_hfreeentries(pTHX_ HV *hv)
1673 {
1674     STRLEN index = 0;
1675     XPVHV * const xhv = (XPVHV*)SvANY(hv);
1676     SV *sv;
1677
1678     PERL_ARGS_ASSERT_HFREEENTRIES;
1679
1680     while ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))||xhv->xhv_keys) {
1681         SvREFCNT_dec(sv);
1682     }
1683 }
1684
1685
1686 /* hfree_next_entry()
1687  * For use only by S_hfreeentries() and sv_clear().
1688  * Delete the next available HE from hv and return the associated SV.
1689  * Returns null on empty hash. Nevertheless null is not a reliable
1690  * indicator that the hash is empty, as the deleted entry may have a
1691  * null value.
1692  * indexp is a pointer to the current index into HvARRAY. The index should
1693  * initially be set to 0. hfree_next_entry() may update it.  */
1694
1695 SV*
1696 Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
1697 {
1698     struct xpvhv_aux *iter;
1699     HE *entry;
1700     HE ** array;
1701 #ifdef DEBUGGING
1702     STRLEN orig_index = *indexp;
1703 #endif
1704
1705     PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY;
1706
1707     if (SvOOK(hv) && ((iter = HvAUX(hv)))) {
1708         if ((entry = iter->xhv_eiter)) {
1709             /* the iterator may get resurrected after each
1710              * destructor call, so check each time */
1711             if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
1712                 HvLAZYDEL_off(hv);
1713                 hv_free_ent(hv, entry);
1714                 /* warning: at this point HvARRAY may have been
1715                  * re-allocated, HvMAX changed etc */
1716             }
1717             iter = HvAUX(hv); /* may have been realloced */
1718             iter->xhv_riter = -1;       /* HvRITER(hv) = -1 */
1719             iter->xhv_eiter = NULL;     /* HvEITER(hv) = NULL */
1720 #ifdef PERL_HASH_RANDOMIZE_KEYS
1721             iter->xhv_last_rand = iter->xhv_rand;
1722 #endif
1723         }
1724         /* Reset any cached HvFILL() to "unknown".  It's unlikely that anyone
1725            will actually call HvFILL() on a hash under destruction, so it
1726            seems pointless attempting to track the number of keys remaining.
1727            But if they do, we want to reset it again.  */
1728         if (iter->xhv_fill_lazy)
1729             iter->xhv_fill_lazy = 0;
1730     }
1731
1732     if (!((XPVHV*)SvANY(hv))->xhv_keys)
1733         return NULL;
1734
1735     array = HvARRAY(hv);
1736     assert(array);
1737     while ( ! ((entry = array[*indexp])) ) {
1738         if ((*indexp)++ >= HvMAX(hv))
1739             *indexp = 0;
1740         assert(*indexp != orig_index);
1741     }
1742     array[*indexp] = HeNEXT(entry);
1743     ((XPVHV*) SvANY(hv))->xhv_keys--;
1744
1745     if (   PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv)
1746         && HeVAL(entry) && isGV(HeVAL(entry))
1747         && GvHV(HeVAL(entry)) && HvENAME(GvHV(HeVAL(entry)))
1748     ) {
1749         STRLEN klen;
1750         const char * const key = HePV(entry,klen);
1751         if ((klen > 1 && key[klen-1]==':' && key[klen-2]==':')
1752          || (klen == 1 && key[0] == ':')) {
1753             mro_package_moved(
1754              NULL, GvHV(HeVAL(entry)),
1755              (GV *)HeVAL(entry), 0
1756             );
1757         }
1758     }
1759     return hv_free_ent_ret(hv, entry);
1760 }
1761
1762
1763 /*
1764 =for apidoc hv_undef
1765
1766 Undefines the hash.  The XS equivalent of C<undef(%hash)>.
1767
1768 As well as freeing all the elements of the hash (like hv_clear()), this
1769 also frees any auxiliary data and storage associated with the hash.
1770
1771 If any destructors are triggered as a result, the hv itself may
1772 be freed.
1773
1774 See also L</hv_clear>.
1775
1776 =cut
1777 */
1778
1779 void
1780 Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
1781 {
1782     dVAR;
1783     XPVHV* xhv;
1784     bool save;
1785
1786     if (!hv)
1787         return;
1788     save = !!SvREFCNT(hv);
1789     DEBUG_A(Perl_hv_assert(aTHX_ hv));
1790     xhv = (XPVHV*)SvANY(hv);
1791
1792     /* The name must be deleted before the call to hfreeeeentries so that
1793        CVs are anonymised properly. But the effective name must be pre-
1794        served until after that call (and only deleted afterwards if the
1795        call originated from sv_clear). For stashes with one name that is
1796        both the canonical name and the effective name, hv_name_set has to
1797        allocate an array for storing the effective name. We can skip that
1798        during global destruction, as it does not matter where the CVs point
1799        if they will be freed anyway. */
1800     /* note that the code following prior to hfreeentries is duplicated
1801      * in sv_clear(), and changes here should be done there too */
1802     if (PL_phase != PERL_PHASE_DESTRUCT && HvNAME(hv)) {
1803         if (PL_stashcache) {
1804             DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
1805                              HEKf"'\n", HvNAME_HEK(hv)));
1806             (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD);
1807         }
1808         hv_name_set(hv, NULL, 0, 0);
1809     }
1810     if (save) {
1811         ENTER;
1812         SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
1813     }
1814     hfreeentries(hv);
1815     if (SvOOK(hv)) {
1816       struct mro_meta *meta;
1817       const char *name;
1818
1819       if (HvENAME_get(hv)) {
1820         if (PL_phase != PERL_PHASE_DESTRUCT)
1821             mro_isa_changed_in(hv);
1822         if (PL_stashcache) {
1823             DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%"
1824                              HEKf"'\n", HvENAME_HEK(hv)));
1825             (void)hv_deletehek(PL_stashcache, HvENAME_HEK(hv), G_DISCARD);
1826         }
1827       }
1828
1829       /* If this call originated from sv_clear, then we must check for
1830        * effective names that need freeing, as well as the usual name. */
1831       name = HvNAME(hv);
1832       if (flags & HV_NAME_SETALL ? !!HvAUX(hv)->xhv_name_u.xhvnameu_name : !!name) {
1833         if (name && PL_stashcache) {
1834             DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%"
1835                              HEKf"'\n", HvNAME_HEK(hv)));
1836             (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD);
1837         }
1838         hv_name_set(hv, NULL, 0, flags);
1839       }
1840       if((meta = HvAUX(hv)->xhv_mro_meta)) {
1841         if (meta->mro_linear_all) {
1842             SvREFCNT_dec_NN(meta->mro_linear_all);
1843             /* mro_linear_current is just acting as a shortcut pointer,
1844                hence the else.  */
1845         }
1846         else
1847             /* Only the current MRO is stored, so this owns the data.
1848              */
1849             SvREFCNT_dec(meta->mro_linear_current);
1850         SvREFCNT_dec(meta->mro_nextmethod);
1851         SvREFCNT_dec(meta->isa);
1852         SvREFCNT_dec(meta->super);
1853         Safefree(meta);
1854         HvAUX(hv)->xhv_mro_meta = NULL;
1855       }
1856       if (!HvAUX(hv)->xhv_name_u.xhvnameu_name && ! HvAUX(hv)->xhv_backreferences)
1857         SvFLAGS(hv) &= ~SVf_OOK;
1858     }
1859     if (!SvOOK(hv)) {
1860         Safefree(HvARRAY(hv));
1861         xhv->xhv_max = PERL_HASH_DEFAULT_HvMAX;        /* HvMAX(hv) = 7 (it's a normal hash) */
1862         HvARRAY(hv) = 0;
1863     }
1864     /* if we're freeing the HV, the SvMAGIC field has been reused for
1865      * other purposes, and so there can't be any placeholder magic */
1866     if (SvREFCNT(hv))
1867         HvPLACEHOLDERS_set(hv, 0);
1868
1869     if (SvRMAGICAL(hv))
1870         mg_clear(MUTABLE_SV(hv));
1871     if (save) LEAVE;
1872 }
1873
1874 /*
1875 =for apidoc hv_fill
1876
1877 Returns the number of hash buckets that
1878 happen to be in use.  This function is
1879 wrapped by the macro C<HvFILL>.
1880
1881 Previously this value was always stored in the HV structure, which created an
1882 overhead on every hash (and pretty much every object) for something that was
1883 rarely used.  Now we calculate it on demand the first
1884 time that it is needed, and cache it if that calculation
1885 is going to be costly to repeat.  The cached
1886 value is updated by insertions and deletions, but (currently) discarded if
1887 the hash is split.
1888
1889 =cut
1890 */
1891
1892 STRLEN
1893 Perl_hv_fill(pTHX_ HV *const hv)
1894 {
1895     STRLEN count = 0;
1896     HE **ents = HvARRAY(hv);
1897     struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : NULL;
1898
1899     PERL_ARGS_ASSERT_HV_FILL;
1900
1901     /* No keys implies no buckets used.
1902        One key can only possibly mean one bucket used.  */
1903     if (HvTOTALKEYS(hv) < 2)
1904         return HvTOTALKEYS(hv);
1905
1906 #ifndef DEBUGGING
1907     if (aux && aux->xhv_fill_lazy)
1908         return aux->xhv_fill_lazy;
1909 #endif
1910
1911     if (ents) {
1912         HE *const *const last = ents + HvMAX(hv);
1913         count = last + 1 - ents;
1914
1915         do {
1916             if (!*ents)
1917                 --count;
1918         } while (++ents <= last);
1919     }
1920     if (aux) {
1921 #ifdef DEBUGGING
1922         if (aux->xhv_fill_lazy)
1923             assert(aux->xhv_fill_lazy == count);
1924 #endif
1925         aux->xhv_fill_lazy = count;
1926     } else if (HvMAX(hv) >= HV_FILL_THRESHOLD) {
1927         aux = hv_auxinit(hv);
1928         aux->xhv_fill_lazy = count;
1929     }        
1930     return count;
1931 }
1932
1933 /* hash a pointer to a U32 - Used in the hash traversal randomization
1934  * and bucket order randomization code
1935  *
1936  * this code was derived from Sereal, which was derived from autobox.
1937  */
1938
1939 PERL_STATIC_INLINE U32 S_ptr_hash(PTRV u) {
1940 #if PTRSIZE == 8
1941     /*
1942      * This is one of Thomas Wang's hash functions for 64-bit integers from:
1943      * http://www.concentric.net/~Ttwang/tech/inthash.htm
1944      */
1945     u = (~u) + (u << 18);
1946     u = u ^ (u >> 31);
1947     u = u * 21;
1948     u = u ^ (u >> 11);
1949     u = u + (u << 6);
1950     u = u ^ (u >> 22);
1951 #else
1952     /*
1953      * This is one of Bob Jenkins' hash functions for 32-bit integers
1954      * from: http://burtleburtle.net/bob/hash/integer.html
1955      */
1956     u = (u + 0x7ed55d16) + (u << 12);
1957     u = (u ^ 0xc761c23c) ^ (u >> 19);
1958     u = (u + 0x165667b1) + (u << 5);
1959     u = (u + 0xd3a2646c) ^ (u << 9);
1960     u = (u + 0xfd7046c5) + (u << 3);
1961     u = (u ^ 0xb55a4f09) ^ (u >> 16);
1962 #endif
1963     return (U32)u;
1964 }
1965
1966 static struct xpvhv_aux*
1967 S_hv_auxinit_internal(struct xpvhv_aux *iter) {
1968     PERL_ARGS_ASSERT_HV_AUXINIT_INTERNAL;
1969     iter->xhv_riter = -1;       /* HvRITER(hv) = -1 */
1970     iter->xhv_eiter = NULL;     /* HvEITER(hv) = NULL */
1971 #ifdef PERL_HASH_RANDOMIZE_KEYS
1972     iter->xhv_last_rand = iter->xhv_rand;
1973 #endif
1974     iter->xhv_fill_lazy = 0;
1975     iter->xhv_name_u.xhvnameu_name = 0;
1976     iter->xhv_name_count = 0;
1977     iter->xhv_backreferences = 0;
1978     iter->xhv_mro_meta = NULL;
1979     iter->xhv_aux_flags = 0;
1980     return iter;
1981 }
1982
1983
1984 static struct xpvhv_aux*
1985 S_hv_auxinit(pTHX_ HV *hv) {
1986     struct xpvhv_aux *iter;
1987     char *array;
1988
1989     PERL_ARGS_ASSERT_HV_AUXINIT;
1990
1991     if (!SvOOK(hv)) {
1992         if (!HvARRAY(hv)) {
1993             Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
1994                 + sizeof(struct xpvhv_aux), char);
1995         } else {
1996             array = (char *) HvARRAY(hv);
1997             Renew(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
1998                   + sizeof(struct xpvhv_aux), char);
1999         }
2000         HvARRAY(hv) = (HE**)array;
2001         SvOOK_on(hv);
2002         iter = HvAUX(hv);
2003 #ifdef PERL_HASH_RANDOMIZE_KEYS
2004         if (PL_HASH_RAND_BITS_ENABLED) {
2005             /* mix in some new state to PL_hash_rand_bits to "randomize" the traversal order*/
2006             if (PL_HASH_RAND_BITS_ENABLED == 1)
2007                 PL_hash_rand_bits += ptr_hash((PTRV)array);
2008             PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,1);
2009         }
2010         iter->xhv_rand = (U32)PL_hash_rand_bits;
2011 #endif
2012     } else {
2013         iter = HvAUX(hv);
2014     }
2015
2016     return hv_auxinit_internal(iter);
2017 }
2018
2019 /*
2020 =for apidoc hv_iterinit
2021
2022 Prepares a starting point to traverse a hash table.  Returns the number of
2023 keys in the hash (i.e. the same as C<HvUSEDKEYS(hv)>).  The return value is
2024 currently only meaningful for hashes without tie magic.
2025
2026 NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
2027 hash buckets that happen to be in use.  If you still need that esoteric
2028 value, you can get it through the macro C<HvFILL(hv)>.
2029
2030
2031 =cut
2032 */
2033
2034 I32
2035 Perl_hv_iterinit(pTHX_ HV *hv)
2036 {
2037     PERL_ARGS_ASSERT_HV_ITERINIT;
2038
2039     /* FIXME: Are we not NULL, or do we croak? Place bets now! */
2040
2041     if (!hv)
2042         Perl_croak(aTHX_ "Bad hash");
2043
2044     if (SvOOK(hv)) {
2045         struct xpvhv_aux * iter = HvAUX(hv);
2046         HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
2047         if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
2048             HvLAZYDEL_off(hv);
2049             hv_free_ent(hv, entry);
2050         }
2051         iter = HvAUX(hv); /* may have been reallocated */
2052         iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
2053         iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
2054 #ifdef PERL_HASH_RANDOMIZE_KEYS
2055         iter->xhv_last_rand = iter->xhv_rand;
2056 #endif
2057     } else {
2058         hv_auxinit(hv);
2059     }
2060
2061     /* used to be xhv->xhv_fill before 5.004_65 */
2062     return HvTOTALKEYS(hv);
2063 }
2064
2065 I32 *
2066 Perl_hv_riter_p(pTHX_ HV *hv) {
2067     struct xpvhv_aux *iter;
2068
2069     PERL_ARGS_ASSERT_HV_RITER_P;
2070
2071     if (!hv)
2072         Perl_croak(aTHX_ "Bad hash");
2073
2074     iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
2075     return &(iter->xhv_riter);
2076 }
2077
2078 HE **
2079 Perl_hv_eiter_p(pTHX_ HV *hv) {
2080     struct xpvhv_aux *iter;
2081
2082     PERL_ARGS_ASSERT_HV_EITER_P;
2083
2084     if (!hv)
2085         Perl_croak(aTHX_ "Bad hash");
2086
2087     iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
2088     return &(iter->xhv_eiter);
2089 }
2090
2091 void
2092 Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {
2093     struct xpvhv_aux *iter;
2094
2095     PERL_ARGS_ASSERT_HV_RITER_SET;
2096
2097     if (!hv)
2098         Perl_croak(aTHX_ "Bad hash");
2099
2100     if (SvOOK(hv)) {
2101         iter = HvAUX(hv);
2102     } else {
2103         if (riter == -1)
2104             return;
2105
2106         iter = hv_auxinit(hv);
2107     }
2108     iter->xhv_riter = riter;
2109 }
2110
2111 void
2112 Perl_hv_rand_set(pTHX_ HV *hv, U32 new_xhv_rand) {
2113     struct xpvhv_aux *iter;
2114
2115     PERL_ARGS_ASSERT_HV_RAND_SET;
2116
2117 #ifdef PERL_HASH_RANDOMIZE_KEYS
2118     if (!hv)
2119         Perl_croak(aTHX_ "Bad hash");
2120
2121     if (SvOOK(hv)) {
2122         iter = HvAUX(hv);
2123     } else {
2124         iter = hv_auxinit(hv);
2125     }
2126     iter->xhv_rand = new_xhv_rand;
2127 #else
2128     Perl_croak(aTHX_ "This Perl has not been built with support for randomized hash key traversal but something called Perl_hv_rand_set().");
2129 #endif
2130 }
2131
2132 void
2133 Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
2134     struct xpvhv_aux *iter;
2135
2136     PERL_ARGS_ASSERT_HV_EITER_SET;
2137
2138     if (!hv)
2139         Perl_croak(aTHX_ "Bad hash");
2140
2141     if (SvOOK(hv)) {
2142         iter = HvAUX(hv);
2143     } else {
2144         /* 0 is the default so don't go malloc()ing a new structure just to
2145            hold 0.  */
2146         if (!eiter)
2147             return;
2148
2149         iter = hv_auxinit(hv);
2150     }
2151     iter->xhv_eiter = eiter;
2152 }
2153
2154 void
2155 Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
2156 {
2157     dVAR;
2158     struct xpvhv_aux *iter;
2159     U32 hash;
2160     HEK **spot;
2161
2162     PERL_ARGS_ASSERT_HV_NAME_SET;
2163
2164     if (len > I32_MAX)
2165         Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
2166
2167     if (SvOOK(hv)) {
2168         iter = HvAUX(hv);
2169         if (iter->xhv_name_u.xhvnameu_name) {
2170             if(iter->xhv_name_count) {
2171               if(flags & HV_NAME_SETALL) {
2172                 HEK ** const name = HvAUX(hv)->xhv_name_u.xhvnameu_names;
2173                 HEK **hekp = name + (
2174                     iter->xhv_name_count < 0
2175                      ? -iter->xhv_name_count
2176                      :  iter->xhv_name_count
2177                    );
2178                 while(hekp-- > name+1) 
2179                     unshare_hek_or_pvn(*hekp, 0, 0, 0);
2180                 /* The first elem may be null. */
2181                 if(*name) unshare_hek_or_pvn(*name, 0, 0, 0);
2182                 Safefree(name);
2183                 iter = HvAUX(hv); /* may been realloced */
2184                 spot = &iter->xhv_name_u.xhvnameu_name;
2185                 iter->xhv_name_count = 0;
2186               }
2187               else {
2188                 if(iter->xhv_name_count > 0) {
2189                     /* shift some things over */
2190                     Renew(
2191                      iter->xhv_name_u.xhvnameu_names, iter->xhv_name_count + 1, HEK *
2192                     );
2193                     spot = iter->xhv_name_u.xhvnameu_names;
2194                     spot[iter->xhv_name_count] = spot[1];
2195                     spot[1] = spot[0];
2196                     iter->xhv_name_count = -(iter->xhv_name_count + 1);
2197                 }
2198                 else if(*(spot = iter->xhv_name_u.xhvnameu_names)) {
2199                     unshare_hek_or_pvn(*spot, 0, 0, 0);
2200                 }
2201               }
2202             }
2203             else if (flags & HV_NAME_SETALL) {
2204                 unshare_hek_or_pvn(iter->xhv_name_u.xhvnameu_name, 0, 0, 0);
2205                 iter = HvAUX(hv); /* may been realloced */
2206                 spot = &iter->xhv_name_u.xhvnameu_name;
2207             }
2208             else {
2209                 HEK * const existing_name = iter->xhv_name_u.xhvnameu_name;
2210                 Newx(iter->xhv_name_u.xhvnameu_names, 2, HEK *);
2211                 iter->xhv_name_count = -2;
2212                 spot = iter->xhv_name_u.xhvnameu_names;
2213                 spot[1] = existing_name;
2214             }
2215         }
2216         else { spot = &iter->xhv_name_u.xhvnameu_name; iter->xhv_name_count = 0; }
2217     } else {
2218         if (name == 0)
2219             return;
2220
2221         iter = hv_auxinit(hv);
2222         spot = &iter->xhv_name_u.xhvnameu_name;
2223     }
2224     PERL_HASH(hash, name, len);
2225     *spot = name ? share_hek(name, flags & SVf_UTF8 ? -(I32)len : (I32)len, hash) : NULL;
2226 }
2227
2228 /*
2229 This is basically sv_eq_flags() in sv.c, but we avoid the magic
2230 and bytes checking.
2231 */
2232
2233 STATIC I32
2234 hek_eq_pvn_flags(pTHX_ const HEK *hek, const char* pv, const I32 pvlen, const U32 flags) {
2235     if ( (HEK_UTF8(hek) ? 1 : 0) != (flags & SVf_UTF8 ? 1 : 0) ) {
2236         if (flags & SVf_UTF8)
2237             return (bytes_cmp_utf8(
2238                         (const U8*)HEK_KEY(hek), HEK_LEN(hek),
2239                         (const U8*)pv, pvlen) == 0);
2240         else
2241             return (bytes_cmp_utf8(
2242                         (const U8*)pv, pvlen,
2243                         (const U8*)HEK_KEY(hek), HEK_LEN(hek)) == 0);
2244     }
2245     else
2246         return HEK_LEN(hek) == pvlen && ((HEK_KEY(hek) == pv)
2247                     || memEQ(HEK_KEY(hek), pv, pvlen));
2248 }
2249
2250 /*
2251 =for apidoc hv_ename_add
2252
2253 Adds a name to a stash's internal list of effective names.  See
2254 C<hv_ename_delete>.
2255
2256 This is called when a stash is assigned to a new location in the symbol
2257 table.
2258
2259 =cut
2260 */
2261
2262 void
2263 Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
2264 {
2265     dVAR;
2266     struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
2267     U32 hash;
2268
2269     PERL_ARGS_ASSERT_HV_ENAME_ADD;
2270
2271     if (len > I32_MAX)
2272         Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
2273
2274     PERL_HASH(hash, name, len);
2275
2276     if (aux->xhv_name_count) {
2277         HEK ** const xhv_name = aux->xhv_name_u.xhvnameu_names;
2278         I32 count = aux->xhv_name_count;
2279         HEK **hekp = xhv_name + (count < 0 ? -count : count);
2280         while (hekp-- > xhv_name)
2281             if (
2282                  (HEK_UTF8(*hekp) || (flags & SVf_UTF8)) 
2283                     ? hek_eq_pvn_flags(aTHX_ *hekp, name, (I32)len, flags)
2284                     : (HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len))
2285                ) {
2286                 if (hekp == xhv_name && count < 0)
2287                     aux->xhv_name_count = -count;
2288                 return;
2289             }
2290         if (count < 0) aux->xhv_name_count--, count = -count;
2291         else aux->xhv_name_count++;
2292         Renew(aux->xhv_name_u.xhvnameu_names, count + 1, HEK *);
2293         (aux->xhv_name_u.xhvnameu_names)[count] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash);
2294     }
2295     else {
2296         HEK *existing_name = aux->xhv_name_u.xhvnameu_name;
2297         if (
2298             existing_name && (
2299              (HEK_UTF8(existing_name) || (flags & SVf_UTF8))
2300                 ? hek_eq_pvn_flags(aTHX_ existing_name, name, (I32)len, flags)
2301                 : (HEK_LEN(existing_name) == (I32)len && memEQ(HEK_KEY(existing_name), name, len))
2302             )
2303         ) return;
2304         Newx(aux->xhv_name_u.xhvnameu_names, 2, HEK *);
2305         aux->xhv_name_count = existing_name ? 2 : -2;
2306         *aux->xhv_name_u.xhvnameu_names = existing_name;
2307         (aux->xhv_name_u.xhvnameu_names)[1] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash);
2308     }
2309 }
2310
2311 /*
2312 =for apidoc hv_ename_delete
2313
2314 Removes a name from a stash's internal list of effective names.  If this is
2315 the name returned by C<HvENAME>, then another name in the list will take
2316 its place (C<HvENAME> will use it).
2317
2318 This is called when a stash is deleted from the symbol table.
2319
2320 =cut
2321 */
2322
2323 void
2324 Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
2325 {
2326     dVAR;
2327     struct xpvhv_aux *aux;
2328
2329     PERL_ARGS_ASSERT_HV_ENAME_DELETE;
2330
2331     if (len > I32_MAX)
2332         Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
2333
2334     if (!SvOOK(hv)) return;
2335
2336     aux = HvAUX(hv);
2337     if (!aux->xhv_name_u.xhvnameu_name) return;
2338
2339     if (aux->xhv_name_count) {
2340         HEK ** const namep = aux->xhv_name_u.xhvnameu_names;
2341         I32 const count = aux->xhv_name_count;
2342         HEK **victim = namep + (count < 0 ? -count : count);
2343         while (victim-- > namep + 1)
2344             if (
2345              (HEK_UTF8(*victim) || (flags & SVf_UTF8)) 
2346                 ? hek_eq_pvn_flags(aTHX_ *victim, name, (I32)len, flags)
2347                 : (HEK_LEN(*victim) == (I32)len && memEQ(HEK_KEY(*victim), name, len))
2348             ) {
2349                 unshare_hek_or_pvn(*victim, 0, 0, 0);
2350                 aux = HvAUX(hv); /* may been realloced */
2351                 if (count < 0) ++aux->xhv_name_count;
2352                 else --aux->xhv_name_count;
2353                 if (
2354                     (aux->xhv_name_count == 1 || aux->xhv_name_count == -1)
2355                  && !*namep
2356                 ) {  /* if there are none left */
2357                     Safefree(namep);
2358                     aux->xhv_name_u.xhvnameu_names = NULL;
2359                     aux->xhv_name_count = 0;
2360                 }
2361                 else {
2362                     /* Move the last one back to fill the empty slot. It
2363                        does not matter what order they are in. */
2364                     *victim = *(namep + (count < 0 ? -count : count) - 1);
2365                 }
2366                 return;
2367             }
2368         if (
2369             count > 0 && (HEK_UTF8(*namep) || (flags & SVf_UTF8)) 
2370                 ? hek_eq_pvn_flags(aTHX_ *namep, name, (I32)len, flags)
2371                 : (HEK_LEN(*namep) == (I32)len && memEQ(HEK_KEY(*namep), name, len))
2372         ) {
2373             aux->xhv_name_count = -count;
2374         }
2375     }
2376     else if(
2377         (HEK_UTF8(aux->xhv_name_u.xhvnameu_name) || (flags & SVf_UTF8)) 
2378                 ? hek_eq_pvn_flags(aTHX_ aux->xhv_name_u.xhvnameu_name, name, (I32)len, flags)
2379                 : (HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len &&
2380                             memEQ(HEK_KEY(aux->xhv_name_u.xhvnameu_name), name, len))
2381     ) {
2382         HEK * const namehek = aux->xhv_name_u.xhvnameu_name;
2383         Newx(aux->xhv_name_u.xhvnameu_names, 1, HEK *);
2384         *aux->xhv_name_u.xhvnameu_names = namehek;
2385         aux->xhv_name_count = -1;
2386     }
2387 }
2388
2389 AV **
2390 Perl_hv_backreferences_p(pTHX_ HV *hv) {
2391     struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
2392
2393     PERL_ARGS_ASSERT_HV_BACKREFERENCES_P;
2394     PERL_UNUSED_CONTEXT;
2395
2396     return &(iter->xhv_backreferences);
2397 }
2398
2399 void
2400 Perl_hv_kill_backrefs(pTHX_ HV *hv) {
2401     AV *av;
2402
2403     PERL_ARGS_ASSERT_HV_KILL_BACKREFS;
2404
2405     if (!SvOOK(hv))
2406         return;
2407
2408     av = HvAUX(hv)->xhv_backreferences;
2409
2410     if (av) {
2411         HvAUX(hv)->xhv_backreferences = 0;
2412         Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
2413         if (SvTYPE(av) == SVt_PVAV)
2414             SvREFCNT_dec_NN(av);
2415     }
2416 }
2417
2418 /*
2419 hv_iternext is implemented as a macro in hv.h
2420
2421 =for apidoc hv_iternext
2422
2423 Returns entries from a hash iterator.  See C<hv_iterinit>.
2424
2425 You may call C<hv_delete> or C<hv_delete_ent> on the hash entry that the
2426 iterator currently points to, without losing your place or invalidating your
2427 iterator.  Note that in this case the current entry is deleted from the hash
2428 with your iterator holding the last reference to it.  Your iterator is flagged
2429 to free the entry on the next call to C<hv_iternext>, so you must not discard
2430 your iterator immediately else the entry will leak - call C<hv_iternext> to
2431 trigger the resource deallocation.
2432
2433 =for apidoc hv_iternext_flags
2434
2435 Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
2436 The C<flags> value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is
2437 set the placeholders keys (for restricted hashes) will be returned in addition
2438 to normal keys.  By default placeholders are automatically skipped over.
2439 Currently a placeholder is implemented with a value that is
2440 C<&PL_sv_placeholder>.  Note that the implementation of placeholders and
2441 restricted hashes may change, and the implementation currently is
2442 insufficiently abstracted for any change to be tidy.
2443
2444 =cut
2445 */
2446
2447 HE *
2448 Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
2449 {
2450     dVAR;
2451     XPVHV* xhv;
2452     HE *entry;
2453     HE *oldentry;
2454     MAGIC* mg;
2455     struct xpvhv_aux *iter;
2456
2457     PERL_ARGS_ASSERT_HV_ITERNEXT_FLAGS;
2458
2459     if (!hv)
2460         Perl_croak(aTHX_ "Bad hash");
2461
2462     xhv = (XPVHV*)SvANY(hv);
2463
2464     if (!SvOOK(hv)) {
2465         /* Too many things (well, pp_each at least) merrily assume that you can
2466            call hv_iternext without calling hv_iterinit, so we'll have to deal
2467            with it.  */
2468         hv_iterinit(hv);
2469     }
2470     iter = HvAUX(hv);
2471
2472     oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
2473     if (SvMAGICAL(hv) && SvRMAGICAL(hv)) {
2474         if ( ( mg = mg_find((const SV *)hv, PERL_MAGIC_tied) ) ) {
2475             SV * const key = sv_newmortal();
2476             if (entry) {
2477                 sv_setsv(key, HeSVKEY_force(entry));
2478                 SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
2479                 HeSVKEY_set(entry, NULL);
2480             }
2481             else {
2482                 char *k;
2483                 HEK *hek;
2484
2485                 /* one HE per MAGICAL hash */
2486                 iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
2487                 HvLAZYDEL_on(hv); /* make sure entry gets freed */
2488                 Zero(entry, 1, HE);
2489                 Newxz(k, HEK_BASESIZE + sizeof(const SV *), char);
2490                 hek = (HEK*)k;
2491                 HeKEY_hek(entry) = hek;
2492                 HeKLEN(entry) = HEf_SVKEY;
2493             }
2494             magic_nextpack(MUTABLE_SV(hv),mg,key);
2495             if (SvOK(key)) {
2496                 /* force key to stay around until next time */
2497                 HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key));
2498                 return entry;               /* beware, hent_val is not set */
2499             }
2500             SvREFCNT_dec(HeVAL(entry));
2501             Safefree(HeKEY_hek(entry));
2502             del_HE(entry);
2503             iter = HvAUX(hv); /* may been realloced */
2504             iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
2505             HvLAZYDEL_off(hv);
2506             return NULL;
2507         }
2508     }
2509 #if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__)  /* set up %ENV for iteration */
2510     if (!entry && SvRMAGICAL((const SV *)hv)
2511         && mg_find((const SV *)hv, PERL_MAGIC_env)) {
2512         prime_env_iter();
2513 #ifdef VMS
2514         /* The prime_env_iter() on VMS just loaded up new hash values
2515          * so the iteration count needs to be reset back to the beginning
2516          */
2517         hv_iterinit(hv);
2518         iter = HvAUX(hv);
2519         oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
2520 #endif
2521     }
2522 #endif
2523
2524     /* hv_iterinit now ensures this.  */
2525     assert (HvARRAY(hv));
2526
2527     /* At start of hash, entry is NULL.  */
2528     if (entry)
2529     {
2530         entry = HeNEXT(entry);
2531         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
2532             /*
2533              * Skip past any placeholders -- don't want to include them in
2534              * any iteration.
2535              */
2536             while (entry && HeVAL(entry) == &PL_sv_placeholder) {
2537                 entry = HeNEXT(entry);
2538             }
2539         }
2540     }
2541
2542 #ifdef PERL_HASH_RANDOMIZE_KEYS
2543     if (iter->xhv_last_rand != iter->xhv_rand) {
2544         if (iter->xhv_riter != -1) {
2545             Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
2546                              "Use of each() on hash after insertion without resetting hash iterator results in undefined behavior"
2547                              pTHX__FORMAT
2548                              pTHX__VALUE);
2549         }
2550         iter = HvAUX(hv); /* may been realloced */
2551         iter->xhv_last_rand = iter->xhv_rand;
2552     }
2553 #endif
2554
2555     /* Skip the entire loop if the hash is empty.   */
2556     if ((flags & HV_ITERNEXT_WANTPLACEHOLDERS)
2557         ? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) {
2558         while (!entry) {
2559             /* OK. Come to the end of the current list.  Grab the next one.  */
2560
2561             iter->xhv_riter++; /* HvRITER(hv)++ */
2562             if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
2563                 /* There is no next one.  End of the hash.  */
2564                 iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
2565 #ifdef PERL_HASH_RANDOMIZE_KEYS
2566                 iter->xhv_last_rand = iter->xhv_rand; /* reset xhv_last_rand so we can detect inserts during traversal */
2567 #endif
2568                 break;
2569             }
2570             entry = (HvARRAY(hv))[ PERL_HASH_ITER_BUCKET(iter) & xhv->xhv_max ];
2571
2572             if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
2573                 /* If we have an entry, but it's a placeholder, don't count it.
2574                    Try the next.  */
2575                 while (entry && HeVAL(entry) == &PL_sv_placeholder)
2576                     entry = HeNEXT(entry);
2577             }
2578             /* Will loop again if this linked list starts NULL
2579                (for HV_ITERNEXT_WANTPLACEHOLDERS)
2580                or if we run through it and find only placeholders.  */
2581         }
2582     }
2583     else {
2584         iter->xhv_riter = -1;
2585 #ifdef PERL_HASH_RANDOMIZE_KEYS
2586         iter->xhv_last_rand = iter->xhv_rand;
2587 #endif
2588     }
2589
2590     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
2591         HvLAZYDEL_off(hv);
2592         hv_free_ent(hv, oldentry);
2593     }
2594
2595     iter = HvAUX(hv); /* may been realloced */
2596     iter->xhv_eiter = entry; /* HvEITER(hv) = entry */
2597     return entry;
2598 }
2599
2600 /*
2601 =for apidoc hv_iterkey
2602
2603 Returns the key from the current position of the hash iterator.  See
2604 C<hv_iterinit>.
2605
2606 =cut
2607 */
2608
2609 char *
2610 Perl_hv_iterkey(pTHX_ HE *entry, I32 *retlen)
2611 {
2612     PERL_ARGS_ASSERT_HV_ITERKEY;
2613
2614     if (HeKLEN(entry) == HEf_SVKEY) {
2615         STRLEN len;
2616         char * const p = SvPV(HeKEY_sv(entry), len);
2617         *retlen = len;
2618         return p;
2619     }
2620     else {
2621         *retlen = HeKLEN(entry);
2622         return HeKEY(entry);
2623     }
2624 }
2625
2626 /* unlike hv_iterval(), this always returns a mortal copy of the key */
2627 /*
2628 =for apidoc hv_iterkeysv
2629
2630 Returns the key as an C<SV*> from the current position of the hash
2631 iterator.  The return value will always be a mortal copy of the key.  Also
2632 see C<hv_iterinit>.
2633
2634 =cut
2635 */
2636
2637 SV *
2638 Perl_hv_iterkeysv(pTHX_ HE *entry)
2639 {
2640     PERL_ARGS_ASSERT_HV_ITERKEYSV;
2641
2642     return sv_2mortal(newSVhek(HeKEY_hek(entry)));
2643 }
2644
2645 /*
2646 =for apidoc hv_iterval
2647
2648 Returns the value from the current position of the hash iterator.  See
2649 C<hv_iterkey>.
2650
2651 =cut
2652 */
2653
2654 SV *
2655 Perl_hv_iterval(pTHX_ HV *hv, HE *entry)
2656 {
2657     PERL_ARGS_ASSERT_HV_ITERVAL;
2658
2659     if (SvRMAGICAL(hv)) {
2660         if (mg_find((const SV *)hv, PERL_MAGIC_tied)) {
2661             SV* const sv = sv_newmortal();
2662             if (HeKLEN(entry) == HEf_SVKEY)
2663                 mg_copy(MUTABLE_SV(hv), sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
2664             else
2665                 mg_copy(MUTABLE_SV(hv), sv, HeKEY(entry), HeKLEN(entry));
2666             return sv;
2667         }
2668     }
2669     return HeVAL(entry);
2670 }
2671
2672 /*
2673 =for apidoc hv_iternextsv
2674
2675 Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
2676 operation.
2677
2678 =cut
2679 */
2680
2681 SV *
2682 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
2683 {
2684     HE * const he = hv_iternext_flags(hv, 0);
2685
2686     PERL_ARGS_ASSERT_HV_ITERNEXTSV;
2687
2688     if (!he)
2689         return NULL;
2690     *key = hv_iterkey(he, retlen);
2691     return hv_iterval(hv, he);
2692 }
2693
2694 /*
2695
2696 Now a macro in hv.h
2697
2698 =for apidoc hv_magic
2699
2700 Adds magic to a hash.  See C<sv_magic>.
2701
2702 =cut
2703 */
2704
2705 /* possibly free a shared string if no one has access to it
2706  * len and hash must both be valid for str.
2707  */
2708 void
2709 Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
2710 {
2711     unshare_hek_or_pvn (NULL, str, len, hash);
2712 }
2713
2714
2715 void
2716 Perl_unshare_hek(pTHX_ HEK *hek)
2717 {
2718     assert(hek);
2719     unshare_hek_or_pvn(hek, NULL, 0, 0);
2720 }
2721
2722 /* possibly free a shared string if no one has access to it
2723    hek if non-NULL takes priority over the other 3, else str, len and hash
2724    are used.  If so, len and hash must both be valid for str.
2725  */
2726 STATIC void
2727 S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
2728 {
2729     dVAR;
2730     XPVHV* xhv;
2731     HE *entry;
2732     HE **oentry;
2733     bool is_utf8 = FALSE;
2734     int k_flags = 0;
2735     const char * const save = str;
2736     struct shared_he *he = NULL;
2737
2738     if (hek) {
2739         /* Find the shared he which is just before us in memory.  */
2740         he = (struct shared_he *)(((char *)hek)
2741                                   - STRUCT_OFFSET(struct shared_he,
2742                                                   shared_he_hek));
2743
2744         /* Assert that the caller passed us a genuine (or at least consistent)
2745            shared hek  */
2746         assert (he->shared_he_he.hent_hek == hek);
2747
2748         if (he->shared_he_he.he_valu.hent_refcount - 1) {
2749             --he->shared_he_he.he_valu.hent_refcount;
2750             return;
2751         }
2752
2753         hash = HEK_HASH(hek);
2754     } else if (len < 0) {
2755         STRLEN tmplen = -len;
2756         is_utf8 = TRUE;
2757         /* See the note in hv_fetch(). --jhi */
2758         str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
2759         len = tmplen;
2760         if (is_utf8)
2761             k_flags = HVhek_UTF8;
2762         if (str != save)
2763             k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
2764     }
2765
2766     /* what follows was the moral equivalent of:
2767     if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
2768         if (--*Svp == NULL)
2769             hv_delete(PL_strtab, str, len, G_DISCARD, hash);
2770     } */
2771     xhv = (XPVHV*)SvANY(PL_strtab);
2772     /* assert(xhv_array != 0) */
2773     oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
2774     if (he) {
2775         const HE *const he_he = &(he->shared_he_he);
2776         for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) {
2777             if (entry == he_he)
2778                 break;
2779         }
2780     } else {
2781         const int flags_masked = k_flags & HVhek_MASK;
2782         for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) {
2783             if (HeHASH(entry) != hash)          /* strings can't be equal */
2784                 continue;
2785             if (HeKLEN(entry) != len)
2786                 continue;
2787             if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len))     /* is this it? */
2788                 continue;
2789             if (HeKFLAGS(entry) != flags_masked)
2790                 continue;
2791             break;
2792         }
2793     }
2794
2795     if (entry) {
2796         if (--entry->he_valu.hent_refcount == 0) {
2797             *oentry = HeNEXT(entry);
2798             Safefree(entry);
2799             xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
2800         }
2801     }
2802
2803     if (!entry)
2804         Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
2805                          "Attempt to free nonexistent shared string '%s'%s"
2806                          pTHX__FORMAT,
2807                          hek ? HEK_KEY(hek) : str,
2808                          ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
2809     if (k_flags & HVhek_FREEKEY)
2810         Safefree(str);
2811 }
2812
2813 /* get a (constant) string ptr from the global string table
2814  * string will get added if it is not already there.
2815  * len and hash must both be valid for str.
2816  */
2817 HEK *
2818 Perl_share_hek(pTHX_ const char *str, I32 len, U32 hash)
2819 {
2820     bool is_utf8 = FALSE;
2821     int flags = 0;
2822     const char * const save = str;
2823
2824     PERL_ARGS_ASSERT_SHARE_HEK;
2825
2826     if (len < 0) {
2827       STRLEN tmplen = -len;
2828       is_utf8 = TRUE;
2829       /* See the note in hv_fetch(). --jhi */
2830       str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
2831       len = tmplen;
2832       /* If we were able to downgrade here, then than means that we were passed
2833          in a key which only had chars 0-255, but was utf8 encoded.  */
2834       if (is_utf8)
2835           flags = HVhek_UTF8;
2836       /* If we found we were able to downgrade the string to bytes, then
2837          we should flag that it needs upgrading on keys or each.  Also flag
2838          that we need share_hek_flags to free the string.  */
2839       if (str != save) {
2840           dVAR;
2841           PERL_HASH(hash, str, len);
2842           flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
2843       }
2844     }
2845
2846     return share_hek_flags (str, len, hash, flags);
2847 }
2848
2849 STATIC HEK *
2850 S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
2851 {
2852     dVAR;
2853     HE *entry;
2854     const int flags_masked = flags & HVhek_MASK;
2855     const U32 hindex = hash & (I32) HvMAX(PL_strtab);
2856     XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
2857
2858     PERL_ARGS_ASSERT_SHARE_HEK_FLAGS;
2859
2860     /* what follows is the moral equivalent of:
2861
2862     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
2863         hv_store(PL_strtab, str, len, NULL, hash);
2864
2865         Can't rehash the shared string table, so not sure if it's worth
2866         counting the number of entries in the linked list
2867     */
2868
2869     /* assert(xhv_array != 0) */
2870     entry = (HvARRAY(PL_strtab))[hindex];
2871     for (;entry; entry = HeNEXT(entry)) {
2872         if (HeHASH(entry) != hash)              /* strings can't be equal */
2873             continue;
2874         if (HeKLEN(entry) != len)
2875             continue;
2876         if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
2877             continue;
2878         if (HeKFLAGS(entry) != flags_masked)
2879             continue;
2880         break;
2881     }
2882
2883     if (!entry) {
2884         /* What used to be head of the list.
2885            If this is NULL, then we're the first entry for this slot, which
2886            means we need to increate fill.  */
2887         struct shared_he *new_entry;
2888         HEK *hek;
2889         char *k;
2890         HE **const head = &HvARRAY(PL_strtab)[hindex];
2891         HE *const next = *head;
2892
2893         /* We don't actually store a HE from the arena and a regular HEK.
2894            Instead we allocate one chunk of memory big enough for both,
2895            and put the HEK straight after the HE. This way we can find the
2896            HE directly from the HEK.
2897         */
2898
2899         Newx(k, STRUCT_OFFSET(struct shared_he,
2900                                 shared_he_hek.hek_key[0]) + len + 2, char);
2901         new_entry = (struct shared_he *)k;
2902         entry = &(new_entry->shared_he_he);
2903         hek = &(new_entry->shared_he_hek);
2904
2905         Copy(str, HEK_KEY(hek), len, char);
2906         HEK_KEY(hek)[len] = 0;
2907         HEK_LEN(hek) = len;
2908         HEK_HASH(hek) = hash;
2909         HEK_FLAGS(hek) = (unsigned char)flags_masked;
2910
2911         /* Still "point" to the HEK, so that other code need not know what
2912            we're up to.  */
2913         HeKEY_hek(entry) = hek;
2914         entry->he_valu.hent_refcount = 0;
2915         HeNEXT(entry) = next;
2916         *head = entry;
2917
2918         xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
2919         if (!next) {                    /* initial entry? */
2920         } else if ( DO_HSPLIT(xhv) ) {
2921             const STRLEN oldsize = xhv->xhv_max + 1;
2922             hsplit(PL_strtab, oldsize, oldsize * 2);
2923         }
2924     }
2925
2926     ++entry->he_valu.hent_refcount;
2927
2928     if (flags & HVhek_FREEKEY)
2929         Safefree(str);
2930
2931     return HeKEY_hek(entry);
2932 }
2933
2934 SSize_t *
2935 Perl_hv_placeholders_p(pTHX_ HV *hv)
2936 {
2937     dVAR;
2938     MAGIC *mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
2939
2940     PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P;
2941
2942     if (!mg) {
2943         mg = sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, 0);
2944
2945         if (!mg) {
2946             Perl_die(aTHX_ "panic: hv_placeholders_p");
2947         }
2948     }
2949     return &(mg->mg_len);
2950 }
2951
2952
2953 I32
2954 Perl_hv_placeholders_get(pTHX_ const HV *hv)
2955 {
2956     dVAR;
2957     MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
2958
2959     PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET;
2960
2961     return mg ? mg->mg_len : 0;
2962 }
2963
2964 void
2965 Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
2966 {
2967     dVAR;
2968     MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
2969
2970     PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET;
2971
2972     if (mg) {
2973         mg->mg_len = ph;
2974     } else if (ph) {
2975         if (!sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, ph))
2976             Perl_die(aTHX_ "panic: hv_placeholders_set");
2977     }
2978     /* else we don't need to add magic to record 0 placeholders.  */
2979 }
2980
2981 STATIC SV *
2982 S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
2983 {
2984     dVAR;
2985     SV *value;
2986
2987     PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE;
2988
2989     switch(he->refcounted_he_data[0] & HVrhek_typemask) {
2990     case HVrhek_undef:
2991         value = newSV(0);
2992         break;
2993     case HVrhek_delete:
2994         value = &PL_sv_placeholder;
2995         break;
2996     case HVrhek_IV:
2997         value = newSViv(he->refcounted_he_val.refcounted_he_u_iv);
2998         break;
2999     case HVrhek_UV:
3000         value = newSVuv(he->refcounted_he_val.refcounted_he_u_uv);
3001         break;
3002     case HVrhek_PV:
3003     case HVrhek_PV_UTF8:
3004         /* Create a string SV that directly points to the bytes in our
3005            structure.  */
3006         value = newSV_type(SVt_PV);
3007         SvPV_set(value, (char *) he->refcounted_he_data + 1);
3008         SvCUR_set(value, he->refcounted_he_val.refcounted_he_u_len);
3009         /* This stops anything trying to free it  */
3010         SvLEN_set(value, 0);
3011         SvPOK_on(value);
3012         SvREADONLY_on(value);
3013         if ((he->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV_UTF8)
3014             SvUTF8_on(value);
3015         break;
3016     default:
3017         Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %"UVxf,
3018                    (UV)he->refcounted_he_data[0]);
3019     }
3020     return value;
3021 }
3022
3023 /*
3024 =for apidoc m|HV *|refcounted_he_chain_2hv|const struct refcounted_he *c|U32 flags
3025
3026 Generates and returns a C<HV *> representing the content of a
3027 C<refcounted_he> chain.
3028 I<flags> is currently unused and must be zero.
3029
3030 =cut
3031 */
3032 HV *
3033 Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
3034 {
3035     dVAR;
3036     HV *hv;
3037     U32 placeholders, max;
3038
3039     if (flags)
3040         Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %"UVxf,
3041             (UV)flags);
3042
3043     /* We could chase the chain once to get an idea of the number of keys,
3044        and call ksplit.  But for now we'll make a potentially inefficient
3045        hash with only 8 entries in its array.  */
3046     hv = newHV();
3047     max = HvMAX(hv);
3048     if (!HvARRAY(hv)) {
3049         char *array;
3050         Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(max + 1), char);
3051         HvARRAY(hv) = (HE**)array;
3052     }
3053
3054     placeholders = 0;
3055     while (chain) {
3056 #ifdef USE_ITHREADS
3057         U32 hash = chain->refcounted_he_hash;
3058 #else
3059         U32 hash = HEK_HASH(chain->refcounted_he_hek);
3060 #endif
3061         HE **oentry = &((HvARRAY(hv))[hash & max]);
3062         HE *entry = *oentry;
3063         SV *value;
3064
3065         for (; entry; entry = HeNEXT(entry)) {
3066             if (HeHASH(entry) == hash) {
3067                 /* We might have a duplicate key here.  If so, entry is older
3068                    than the key we've already put in the hash, so if they are
3069                    the same, skip adding entry.  */
3070 #ifdef USE_ITHREADS
3071                 const STRLEN klen = HeKLEN(entry);
3072                 const char *const key = HeKEY(entry);
3073                 if (klen == chain->refcounted_he_keylen
3074                     && (!!HeKUTF8(entry)
3075                         == !!(chain->refcounted_he_data[0] & HVhek_UTF8))
3076                     && memEQ(key, REF_HE_KEY(chain), klen))
3077                     goto next_please;
3078 #else
3079                 if (HeKEY_hek(entry) == chain->refcounted_he_hek)
3080                     goto next_please;
3081                 if (HeKLEN(entry) == HEK_LEN(chain->refcounted_he_hek)
3082                     && HeKUTF8(entry) == HEK_UTF8(chain->refcounted_he_hek)
3083                     && memEQ(HeKEY(entry), HEK_KEY(chain->refcounted_he_hek),
3084                              HeKLEN(entry)))
3085                     goto next_please;
3086 #endif
3087             }
3088         }
3089         assert (!entry);
3090         entry = new_HE();
3091
3092 #ifdef USE_ITHREADS
3093         HeKEY_hek(entry)
3094             = share_hek_flags(REF_HE_KEY(chain),
3095                               chain->refcounted_he_keylen,
3096                               chain->refcounted_he_hash,
3097                               (chain->refcounted_he_data[0]
3098                                & (HVhek_UTF8|HVhek_WASUTF8)));
3099 #else
3100         HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek);
3101 #endif
3102         value = refcounted_he_value(chain);
3103         if (value == &PL_sv_placeholder)
3104             placeholders++;
3105         HeVAL(entry) = value;
3106
3107         /* Link it into the chain.  */
3108         HeNEXT(entry) = *oentry;
3109         *oentry = entry;
3110
3111         HvTOTALKEYS(hv)++;
3112
3113     next_please:
3114         chain = chain->refcounted_he_next;
3115     }
3116
3117     if (placeholders) {
3118         clear_placeholders(hv, placeholders);
3119         HvTOTALKEYS(hv) -= placeholders;
3120     }
3121
3122     /* We could check in the loop to see if we encounter any keys with key
3123        flags, but it's probably not worth it, as this per-hash flag is only
3124        really meant as an optimisation for things like Storable.  */
3125     HvHASKFLAGS_on(hv);
3126     DEBUG_A(Perl_hv_assert(aTHX_ hv));
3127
3128     return hv;
3129 }
3130
3131 /*
3132 =for apidoc m|SV *|refcounted_he_fetch_pvn|const struct refcounted_he *chain|const char *keypv|STRLEN keylen|U32 hash|U32 flags
3133
3134 Search along a C<refcounted_he> chain for an entry with the key specified
3135 by I<keypv> and I<keylen>.  If I<flags> has the C<REFCOUNTED_HE_KEY_UTF8>
3136 bit set, the key octets are interpreted as UTF-8, otherwise they
3137 are interpreted as Latin-1.  I<hash> is a precomputed hash of the key
3138 string, or zero if it has not been precomputed.  Returns a mortal scalar
3139 representing the value associated with the key, or C<&PL_sv_placeholder>
3140 if there is no value associated with the key.
3141
3142 =cut
3143 */
3144
3145 SV *
3146 Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
3147                          const char *keypv, STRLEN keylen, U32 hash, U32 flags)
3148 {
3149     dVAR;
3150     U8 utf8_flag;
3151     PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
3152
3153     if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS))
3154         Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %"UVxf,
3155             (UV)flags);
3156     if (!chain)
3157         return &PL_sv_placeholder;
3158     if (flags & REFCOUNTED_HE_KEY_UTF8) {
3159         /* For searching purposes, canonicalise to Latin-1 where possible. */
3160         const char *keyend = keypv + keylen, *p;
3161         STRLEN nonascii_count = 0;
3162         for (p = keypv; p != keyend; p++) {
3163             if (! UTF8_IS_INVARIANT(*p)) {
3164                 if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) {
3165                     goto canonicalised_key;
3166                 }
3167                 nonascii_count++;
3168                 p++;
3169             }
3170         }
3171         if (nonascii_count) {
3172             char *q;
3173             const char *p = keypv, *keyend = keypv + keylen;
3174             keylen -= nonascii_count;
3175             Newx(q, keylen, char);
3176             SAVEFREEPV(q);
3177             keypv = q;
3178             for (; p != keyend; p++, q++) {
3179                 U8 c = (U8)*p;
3180                 if (UTF8_IS_INVARIANT(c)) {
3181                     *q = (char) c;
3182                 }
3183                 else {
3184                     p++;
3185                     *q = (char) TWO_BYTE_UTF8_TO_NATIVE(c, *p);
3186                 }
3187             }
3188         }
3189         flags &= ~REFCOUNTED_HE_KEY_UTF8;
3190         canonicalised_key: ;
3191     }
3192     utf8_flag = (flags & REFCOUNTED_HE_KEY_UTF8) ? HVhek_UTF8 : 0;
3193     if (!hash)
3194         PERL_HASH(hash, keypv, keylen);
3195
3196     for (; chain; chain = chain->refcounted_he_next) {
3197         if (
3198 #ifdef USE_ITHREADS
3199             hash == chain->refcounted_he_hash &&
3200             keylen == chain->refcounted_he_keylen &&
3201             memEQ(REF_HE_KEY(chain), keypv, keylen) &&
3202             utf8_flag == (chain->refcounted_he_data[0] & HVhek_UTF8)
3203 #else
3204             hash == HEK_HASH(chain->refcounted_he_hek) &&
3205             keylen == (STRLEN)HEK_LEN(chain->refcounted_he_hek) &&
3206             memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) &&
3207             utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8)
3208 #endif
3209         ) {
3210             if (flags & REFCOUNTED_HE_EXISTS)
3211                 return (chain->refcounted_he_data[0] & HVrhek_typemask)
3212                     == HVrhek_delete
3213                     ? NULL : &PL_sv_yes;
3214             return sv_2mortal(refcounted_he_value(chain));
3215         }
3216     }
3217     return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder;
3218 }
3219
3220 /*
3221 =for apidoc m|SV *|refcounted_he_fetch_pv|const struct refcounted_he *chain|const char *key|U32 hash|U32 flags
3222
3223 Like L</refcounted_he_fetch_pvn>, but takes a nul-terminated string
3224 instead of a string/length pair.
3225
3226 =cut
3227 */
3228
3229 SV *
3230 Perl_refcounted_he_fetch_pv(pTHX_ const struct refcounted_he *chain,
3231                          const char *key, U32 hash, U32 flags)
3232 {
3233     PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PV;
3234     return refcounted_he_fetch_pvn(chain, key, strlen(key), hash, flags);
3235 }
3236
3237 /*
3238 =for apidoc m|SV *|refcounted_he_fetch_sv|const struct refcounted_he *chain|SV *key|U32 hash|U32 flags
3239
3240 Like L</refcounted_he_fetch_pvn>, but takes a Perl scalar instead of a
3241 string/length pair.
3242
3243 =cut
3244 */
3245
3246 SV *
3247 Perl_refcounted_he_fetch_sv(pTHX_ const struct refcounted_he *chain,
3248                          SV *key, U32 hash, U32 flags)
3249 {
3250     const char *keypv;
3251     STRLEN keylen;
3252     PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_SV;
3253     if (flags & REFCOUNTED_HE_KEY_UTF8)
3254         Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %"UVxf,
3255             (UV)flags);
3256     keypv = SvPV_const(key, keylen);
3257     if (SvUTF8(key))
3258         flags |= REFCOUNTED_HE_KEY_UTF8;
3259     if (!hash && SvIsCOW_shared_hash(key))
3260         hash = SvSHARED_HASH(key);
3261     return refcounted_he_fetch_pvn(chain, keypv, keylen, hash, flags);
3262 }
3263
3264 /*
3265 =for apidoc m|struct refcounted_he *|refcounted_he_new_pvn|struct refcounted_he *parent|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags
3266
3267 Creates a new C<refcounted_he>.  This consists of a single key/value
3268 pair and a reference to an existing C<refcounted_he> chain (which may
3269 be empty), and thus forms a longer chain.  When using the longer chain,
3270 the new key/value pair takes precedence over any entry for the same key
3271 further along the chain.
3272
3273 The new key is specified by I<keypv> and I<keylen>.  If I<flags> has
3274 the C<REFCOUNTED_HE_KEY_UTF8> bit set, the key octets are interpreted
3275 as UTF-8, otherwise they are interpreted as Latin-1.  I<hash> is
3276 a precomputed hash of the key string, or zero if it has not been
3277 precomputed.
3278
3279 I<value> is the scalar value to store for this key.  I<value> is copied
3280 by this function, which thus does not take ownership of any reference
3281 to it, and later changes to the scalar will not be reflected in the
3282 value visible in the C<refcounted_he>.  Complex types of scalar will not
3283 be stored with referential integrity, but will be coerced to strings.
3284 I<value> may be either null or C<&PL_sv_placeholder> to indicate that no
3285 value is to be associated with the key; this, as with any non-null value,
3286 takes precedence over the existence of a value for the key further along
3287 the chain.
3288
3289 I<parent> points to the rest of the C<refcounted_he> chain to be
3290 attached to the new C<refcounted_he>.  This function takes ownership
3291 of one reference to I<parent>, and returns one reference to the new
3292 C<refcounted_he>.
3293
3294 =cut
3295 */
3296
3297 struct refcounted_he *
3298 Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent,
3299         const char *keypv, STRLEN keylen, U32 hash, SV *value, U32 flags)
3300 {
3301     dVAR;
3302     STRLEN value_len = 0;
3303     const char *value_p = NULL;
3304     bool is_pv;
3305     char value_type;
3306     char hekflags;
3307     STRLEN key_offset = 1;
3308     struct refcounted_he *he;
3309     PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_PVN;
3310
3311     if (!value || value == &PL_sv_placeholder) {
3312         value_type = HVrhek_delete;
3313     } else if (SvPOK(value)) {
3314         value_type = HVrhek_PV;
3315     } else if (SvIOK(value)) {
3316         value_type = SvUOK((const SV *)value) ? HVrhek_UV : HVrhek_IV;
3317     } else if (!SvOK(value)) {
3318         value_type = HVrhek_undef;
3319     } else {
3320         value_type = HVrhek_PV;
3321     }
3322     is_pv = value_type == HVrhek_PV;
3323     if (is_pv) {
3324         /* Do it this way so that the SvUTF8() test is after the SvPV, in case
3325            the value is overloaded, and doesn't yet have the UTF-8flag set.  */
3326         value_p = SvPV_const(value, value_len);
3327         if (SvUTF8(value))
3328             value_type = HVrhek_PV_UTF8;
3329         key_offset = value_len + 2;
3330     }
3331     hekflags = value_type;
3332
3333     if (flags & REFCOUNTED_HE_KEY_UTF8) {
3334         /* Canonicalise to Latin-1 where possible. */
3335         const char *keyend = keypv + keylen, *p;
3336         STRLEN nonascii_count = 0;
3337         for (p = keypv; p != keyend; p++) {
3338             if (! UTF8_IS_INVARIANT(*p)) {
3339                 if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) {
3340                     goto canonicalised_key;
3341                 }
3342                 nonascii_count++;
3343                 p++;
3344             }
3345         }
3346         if (nonascii_count) {
3347             char *q;
3348             const char *p = keypv, *keyend = keypv + keylen;
3349             keylen -= nonascii_count;
3350             Newx(q, keylen, char);
3351             SAVEFREEPV(q);
3352             keypv = q;
3353             for (; p != keyend; p++, q++) {
3354                 U8 c = (U8)*p;
3355                 if (UTF8_IS_INVARIANT(c)) {
3356                     *q = (char) c;
3357                 }
3358                 else {
3359                     p++;
3360                     *q = (char) TWO_BYTE_UTF8_TO_NATIVE(c, *p);
3361                 }
3362             }
3363         }
3364         flags &= ~REFCOUNTED_HE_KEY_UTF8;
3365         canonicalised_key: ;
3366     }
3367     if (flags & REFCOUNTED_HE_KEY_UTF8)
3368         hekflags |= HVhek_UTF8;
3369     if (!hash)
3370         PERL_HASH(hash, keypv, keylen);
3371
3372 #ifdef USE_ITHREADS
3373     he = (struct refcounted_he*)
3374         PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
3375                              + keylen
3376                              + key_offset);
3377 #else
3378     he = (struct refcounted_he*)
3379         PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
3380                              + key_offset);
3381 #endif
3382
3383     he->refcounted_he_next = parent;
3384
3385     if (is_pv) {
3386         Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char);
3387         he->refcounted_he_val.refcounted_he_u_len = value_len;
3388     } else if (value_type == HVrhek_IV) {
3389         he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value);
3390     } else if (value_type == HVrhek_UV) {
3391         he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value);
3392     }
3393
3394 #ifdef USE_ITHREADS
3395     he->refcounted_he_hash = hash;
3396     he->refcounted_he_keylen = keylen;
3397     Copy(keypv, he->refcounted_he_data + key_offset, keylen, char);
3398 #else
3399     he->refcounted_he_hek = share_hek_flags(keypv, keylen, hash, hekflags);
3400 #endif
3401
3402     he->refcounted_he_data[0] = hekflags;
3403     he->refcounted_he_refcnt = 1;
3404
3405     return he;
3406 }
3407
3408 /*
3409 =for apidoc m|struct refcounted_he *|refcounted_he_new_pv|struct refcounted_he *parent|const char *key|U32 hash|SV *value|U32 flags
3410
3411 Like L</refcounted_he_new_pvn>, but takes a nul-terminated string instead
3412 of a string/length pair.
3413
3414 =cut
3415 */
3416
3417 struct refcounted_he *
3418 Perl_refcounted_he_new_pv(pTHX_ struct refcounted_he *parent,
3419         const char *key, U32 hash, SV *value, U32 flags)
3420 {
3421     PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_PV;
3422     return refcounted_he_new_pvn(parent, key, strlen(key), hash, value, flags);
3423 }
3424
3425 /*
3426 =for apidoc m|struct refcounted_he *|refcounted_he_new_sv|struct refcounted_he *parent|SV *key|U32 hash|SV *value|U32 flags
3427
3428 Like L</refcounted_he_new_pvn>, but takes a Perl scalar instead of a
3429 string/length pair.
3430
3431 =cut
3432 */
3433
3434 struct refcounted_he *
3435 Perl_refcounted_he_new_sv(pTHX_ struct refcounted_he *parent,
3436         SV *key, U32 hash, SV *value, U32 flags)
3437 {
3438     const char *keypv;
3439     STRLEN keylen;
3440     PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_SV;
3441     if (flags & REFCOUNTED_HE_KEY_UTF8)
3442         Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %"UVxf,
3443             (UV)flags);
3444     keypv = SvPV_const(key, keylen);
3445     if (SvUTF8(key))
3446         flags |= REFCOUNTED_HE_KEY_UTF8;
3447     if (!hash && SvIsCOW_shared_hash(key))
3448         hash = SvSHARED_HASH(key);
3449     return refcounted_he_new_pvn(parent, keypv, keylen, hash, value, flags);
3450 }
3451
3452 /*
3453 =for apidoc m|void|refcounted_he_free|struct refcounted_he *he
3454
3455 Decrements the reference count of a C<refcounted_he> by one.  If the
3456 reference count reaches zero the structure's memory is freed, which
3457 (recursively) causes a reduction of its parent C<refcounted_he>'s
3458 reference count.  It is safe to pass a null pointer to this function:
3459 no action occurs in this case.
3460
3461 =cut
3462 */
3463
3464 void
3465 Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
3466     dVAR;
3467     PERL_UNUSED_CONTEXT;
3468
3469     while (he) {
3470         struct refcounted_he *copy;
3471         U32 new_count;
3472
3473         HINTS_REFCNT_LOCK;
3474         new_count = --he->refcounted_he_refcnt;
3475         HINTS_REFCNT_UNLOCK;
3476         
3477         if (new_count) {
3478             return;
3479         }
3480
3481 #ifndef USE_ITHREADS
3482         unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0);
3483 #endif
3484         copy = he;
3485         he = he->refcounted_he_next;
3486         PerlMemShared_free(copy);
3487     }
3488 }
3489
3490 /*
3491 =for apidoc m|struct refcounted_he *|refcounted_he_inc|struct refcounted_he *he
3492
3493 Increment the reference count of a C<refcounted_he>.  The pointer to the
3494 C<refcounted_he> is also returned.  It is safe to pass a null pointer
3495 to this function: no action occurs and a null pointer is returned.
3496
3497 =cut
3498 */
3499
3500 struct refcounted_he *
3501 Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
3502 {
3503     dVAR;
3504     if (he) {
3505         HINTS_REFCNT_LOCK;
3506         he->refcounted_he_refcnt++;
3507         HINTS_REFCNT_UNLOCK;
3508     }
3509     return he;
3510 }
3511
3512 /*
3513 =for apidoc cop_fetch_label
3514
3515 Returns the label attached to a cop.
3516 The flags pointer may be set to C<SVf_UTF8> or 0.
3517
3518 =cut
3519 */
3520
3521 /* pp_entereval is aware that labels are stored with a key ':' at the top of
3522    the linked list.  */
3523 const char *
3524 Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) {
3525     struct refcounted_he *const chain = cop->cop_hints_hash;
3526
3527     PERL_ARGS_ASSERT_COP_FETCH_LABEL;
3528
3529     if (!chain)
3530         return NULL;
3531 #ifdef USE_ITHREADS
3532     if (chain->refcounted_he_keylen != 1)
3533         return NULL;
3534     if (*REF_HE_KEY(chain) != ':')
3535         return NULL;
3536 #else
3537     if ((STRLEN)HEK_LEN(chain->refcounted_he_hek) != 1)
3538         return NULL;
3539     if (*HEK_KEY(chain->refcounted_he_hek) != ':')
3540         return NULL;
3541 #endif
3542     /* Stop anyone trying to really mess us up by adding their own value for
3543        ':' into %^H  */
3544     if ((chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV
3545         && (chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV_UTF8)
3546         return NULL;
3547
3548     if (len)
3549         *len = chain->refcounted_he_val.refcounted_he_u_len;
3550     if (flags) {
3551         *flags = ((chain->refcounted_he_data[0] & HVrhek_typemask)
3552                   == HVrhek_PV_UTF8) ? SVf_UTF8 : 0;
3553     }
3554     return chain->refcounted_he_data + 1;
3555 }
3556
3557 /*
3558 =for apidoc cop_store_label
3559
3560 Save a label into a C<cop_hints_hash>.
3561 You need to set flags to C<SVf_UTF8>
3562 for a utf-8 label.
3563
3564 =cut
3565 */
3566
3567 void
3568 Perl_cop_store_label(pTHX_ COP *const cop, const char *label, STRLEN len,
3569                      U32 flags)
3570 {
3571     SV *labelsv;
3572     PERL_ARGS_ASSERT_COP_STORE_LABEL;
3573
3574     if (flags & ~(SVf_UTF8))
3575         Perl_croak(aTHX_ "panic: cop_store_label illegal flag bits 0x%" UVxf,
3576                    (UV)flags);
3577     labelsv = newSVpvn_flags(label, len, SVs_TEMP);
3578     if (flags & SVf_UTF8)
3579         SvUTF8_on(labelsv);
3580     cop->cop_hints_hash
3581         = refcounted_he_new_pvs(cop->cop_hints_hash, ":", labelsv, 0);
3582 }
3583
3584 /*
3585 =for apidoc hv_assert
3586
3587 Check that a hash is in an internally consistent state.
3588
3589 =cut
3590 */
3591
3592 #ifdef DEBUGGING
3593
3594 void
3595 Perl_hv_assert(pTHX_ HV *hv)
3596 {
3597     dVAR;
3598     HE* entry;
3599     int withflags = 0;
3600     int placeholders = 0;
3601     int real = 0;
3602     int bad = 0;
3603     const I32 riter = HvRITER_get(hv);
3604     HE *eiter = HvEITER_get(hv);
3605
3606     PERL_ARGS_ASSERT_HV_ASSERT;
3607
3608     (void)hv_iterinit(hv);
3609
3610     while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
3611         /* sanity check the values */
3612         if (HeVAL(entry) == &PL_sv_placeholder)
3613             placeholders++;
3614         else
3615             real++;
3616         /* sanity check the keys */
3617         if (HeSVKEY(entry)) {
3618             NOOP;   /* Don't know what to check on SV keys.  */
3619         } else if (HeKUTF8(entry)) {
3620             withflags++;
3621             if (HeKWASUTF8(entry)) {
3622                 PerlIO_printf(Perl_debug_log,
3623                             "hash key has both WASUTF8 and UTF8: '%.*s'\n",
3624                             (int) HeKLEN(entry),  HeKEY(entry));
3625                 bad = 1;
3626             }
3627         } else if (HeKWASUTF8(entry))
3628             withflags++;
3629     }
3630     if (!SvTIED_mg((const SV *)hv, PERL_MAGIC_tied)) {
3631         static const char bad_count[] = "Count %d %s(s), but hash reports %d\n";
3632         const int nhashkeys = HvUSEDKEYS(hv);
3633         const int nhashplaceholders = HvPLACEHOLDERS_get(hv);
3634
3635         if (nhashkeys != real) {
3636             PerlIO_printf(Perl_debug_log, bad_count, real, "keys", nhashkeys );
3637             bad = 1;
3638         }
3639         if (nhashplaceholders != placeholders) {
3640             PerlIO_printf(Perl_debug_log, bad_count, placeholders, "placeholder", nhashplaceholders );
3641             bad = 1;
3642         }
3643     }
3644     if (withflags && ! HvHASKFLAGS(hv)) {
3645         PerlIO_printf(Perl_debug_log,
3646                     "Hash has HASKFLAGS off but I count %d key(s) with flags\n",
3647                     withflags);
3648         bad = 1;
3649     }
3650     if (bad) {
3651         sv_dump(MUTABLE_SV(hv));
3652     }
3653     HvRITER_set(hv, riter);             /* Restore hash iterator state */
3654     HvEITER_set(hv, eiter);
3655 }
3656
3657 #endif
3658
3659 /*
3660  * Local variables:
3661  * c-indentation-style: bsd
3662  * c-basic-offset: 4
3663  * indent-tabs-mode: nil
3664  * End:
3665  *
3666  * ex: set ts=8 sts=4 sw=4 et:
3667  */