This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[patch] .s MakeMaker suffix
[perl5.git] / hv.c
CommitLineData
a0d0e21e 1/* hv.c
79072805 2 *
bc89e66f 3 * Copyright (c) 1991-2001, Larry Wall
79072805
LW
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
a0d0e21e
LW
8 */
9
10/*
11 * "I sit beside the fire and think of all that I have seen." --Bilbo
79072805
LW
12 */
13
14#include "EXTERN.h"
864dbfa3 15#define PERL_IN_HV_C
79072805
LW
16#include "perl.h"
17
1c846c1f 18
76e3520e 19STATIC HE*
cea2e8a9 20S_new_he(pTHX)
4633a7c4
LW
21{
22 HE* he;
333f433b
DG
23 LOCK_SV_MUTEX;
24 if (!PL_he_root)
25 more_he();
26 he = PL_he_root;
27 PL_he_root = HeNEXT(he);
28 UNLOCK_SV_MUTEX;
29 return he;
4633a7c4
LW
30}
31
76e3520e 32STATIC void
cea2e8a9 33S_del_he(pTHX_ HE *p)
4633a7c4 34{
333f433b 35 LOCK_SV_MUTEX;
3280af22
NIS
36 HeNEXT(p) = (HE*)PL_he_root;
37 PL_he_root = p;
333f433b 38 UNLOCK_SV_MUTEX;
4633a7c4
LW
39}
40
333f433b 41STATIC void
cea2e8a9 42S_more_he(pTHX)
4633a7c4
LW
43{
44 register HE* he;
45 register HE* heend;
612f20c3
GS
46 XPV *ptr;
47 New(54, ptr, 1008/sizeof(XPV), XPV);
48 ptr->xpv_pv = (char*)PL_he_arenaroot;
49 PL_he_arenaroot = ptr;
50
51 he = (HE*)ptr;
4633a7c4 52 heend = &he[1008 / sizeof(HE) - 1];
612f20c3 53 PL_he_root = ++he;
4633a7c4 54 while (he < heend) {
fde52b5c 55 HeNEXT(he) = (HE*)(he + 1);
4633a7c4
LW
56 he++;
57 }
fde52b5c 58 HeNEXT(he) = 0;
4633a7c4
LW
59}
60
d33b2eba
GS
61#ifdef PURIFY
62
63#define new_HE() (HE*)safemalloc(sizeof(HE))
64#define del_HE(p) safefree((char*)p)
65
66#else
67
68#define new_HE() new_he()
69#define del_HE(p) del_he(p)
70
71#endif
72
76e3520e 73STATIC HEK *
cea2e8a9 74S_save_hek(pTHX_ const char *str, I32 len, U32 hash)
bbce6d69
PP
75{
76 char *k;
77 register HEK *hek;
da58a35d
JH
78 bool is_utf8 = FALSE;
79
80 if (len < 0) {
81 len = -len;
82 is_utf8 = TRUE;
83 }
1c846c1f 84
ff68c719 85 New(54, k, HEK_BASESIZE + len + 1, char);
bbce6d69 86 hek = (HEK*)k;
ff68c719 87 Copy(str, HEK_KEY(hek), len, char);
ff68c719
PP
88 HEK_LEN(hek) = len;
89 HEK_HASH(hek) = hash;
da58a35d 90 HEK_UTF8(hek) = (char)is_utf8;
bbce6d69
PP
91 return hek;
92}
93
94void
864dbfa3 95Perl_unshare_hek(pTHX_ HEK *hek)
bbce6d69 96{
c3654f1a
IH
97 unsharepvn(HEK_KEY(hek),HEK_UTF8(hek)?-HEK_LEN(hek):HEK_LEN(hek),
98 HEK_HASH(hek));
bbce6d69
PP
99}
100
d18c6117
GS
101#if defined(USE_ITHREADS)
102HE *
103Perl_he_dup(pTHX_ HE *e, bool shared)
104{
105 HE *ret;
106
107 if (!e)
108 return Nullhe;
7766f137
GS
109 /* look for it in the table first */
110 ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
111 if (ret)
112 return ret;
113
114 /* create anew and remember what it is */
d33b2eba 115 ret = new_HE();
7766f137
GS
116 ptr_table_store(PL_ptr_table, e, ret);
117
118 HeNEXT(ret) = he_dup(HeNEXT(e),shared);
d18c6117
GS
119 if (HeKLEN(e) == HEf_SVKEY)
120 HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
121 else if (shared)
c3654f1a 122 HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
d18c6117 123 else
c3654f1a 124 HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
d18c6117
GS
125 HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
126 return ret;
127}
128#endif /* USE_ITHREADS */
129
fde52b5c
PP
130/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
131 * contains an SV* */
132
954c1994
GS
133/*
134=for apidoc hv_fetch
135
136Returns the SV which corresponds to the specified key in the hash. The
137C<klen> is the length of the key. If C<lval> is set then the fetch will be
138part of a store. Check that the return value is non-null before
1c846c1f 139dereferencing it to a C<SV*>.
954c1994 140
96f1132b 141See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
954c1994
GS
142information on how to use this function on tied hashes.
143
144=cut
145*/
146
79072805 147SV**
da58a35d 148Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
79072805 149{
fde52b5c 150 register U32 hash;
79072805 151 register HE *entry;
79072805 152 SV *sv;
da58a35d 153 bool is_utf8 = FALSE;
f9a63242 154 const char *keysave = key;
79072805
LW
155
156 if (!hv)
157 return 0;
463ee0b2 158
da58a35d
JH
159 if (klen < 0) {
160 klen = -klen;
161 is_utf8 = TRUE;
162 }
163
8990e307 164 if (SvRMAGICAL(hv)) {
14befaf4 165 if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
8990e307 166 sv = sv_newmortal();
463ee0b2 167 mg_copy((SV*)hv, sv, key, klen);
3280af22
NIS
168 PL_hv_fetch_sv = sv;
169 return &PL_hv_fetch_sv;
463ee0b2 170 }
902173a3 171#ifdef ENV_IS_CASELESS
14befaf4 172 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
e7152ba2
GS
173 U32 i;
174 for (i = 0; i < klen; ++i)
175 if (isLOWER(key[i])) {
79cb57f6 176 char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen))));
e7152ba2
GS
177 SV **ret = hv_fetch(hv, nkey, klen, 0);
178 if (!ret && lval)
179 ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
180 return ret;
181 }
902173a3
GS
182 }
183#endif
463ee0b2
LW
184 }
185
cdff3ec0 186 if (!HvARRAY(hv)) {
1c846c1f 187 if (lval
a0d0e21e 188#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
a3f1c6fb 189 || mg_find((SV*)hv, PERL_MAGIC_env)
a0d0e21e
LW
190#endif
191 )
cdff3ec0 192 Newz(503, HvARRAY(hv),
b72a5635 193 PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1), HE*);
79072805
LW
194 else
195 return 0;
196 }
197
75a54232
JH
198 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
199 STRLEN tmplen = klen;
200 /* Just casting the &klen to (STRLEN) won't work well
201 * if STRLEN and I32 are of different widths. --jhi */
202 key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
203 klen = tmplen;
204 }
f9a63242 205
fde52b5c 206 PERL_HASH(hash, key, klen);
79072805 207
cdff3ec0 208 entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
fde52b5c
PP
209 for (; entry; entry = HeNEXT(entry)) {
210 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 211 continue;
fde52b5c 212 if (HeKLEN(entry) != klen)
79072805 213 continue;
1c846c1f 214 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 215 continue;
c3654f1a
IH
216 if (HeKUTF8(entry) != (char)is_utf8)
217 continue;
f9a63242
JH
218 if (key != keysave)
219 Safefree(key);
fde52b5c 220 return &HeVAL(entry);
79072805 221 }
a0d0e21e 222#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
a3f1c6fb 223 if (mg_find((SV*)hv, PERL_MAGIC_env)) {
a6c40364
GS
224 unsigned long len;
225 char *env = PerlEnv_ENVgetenv_len(key,&len);
226 if (env) {
227 sv = newSVpvn(env,len);
228 SvTAINTED_on(sv);
f9a63242
JH
229 if (key != keysave)
230 Safefree(key);
a6c40364
GS
231 return hv_store(hv,key,klen,sv,hash);
232 }
a0d0e21e
LW
233 }
234#endif
79072805
LW
235 if (lval) { /* gonna assign to this, so it better be there */
236 sv = NEWSV(61,0);
f9a63242
JH
237 if (key != keysave) { /* must be is_utf8 == 0 */
238 SV **ret = hv_store(hv,key,klen,sv,hash);
239 Safefree(key);
240 return ret;
241 }
242 else
243 return hv_store(hv,key,is_utf8?-klen:klen,sv,hash);
79072805 244 }
f9a63242
JH
245 if (key != keysave)
246 Safefree(key);
79072805
LW
247 return 0;
248}
249
fde52b5c
PP
250/* returns a HE * structure with the all fields set */
251/* note that hent_val will be a mortal sv for MAGICAL hashes */
954c1994
GS
252/*
253=for apidoc hv_fetch_ent
254
255Returns the hash entry which corresponds to the specified key in the hash.
256C<hash> must be a valid precomputed hash number for the given C<key>, or 0
257if you want the function to compute it. IF C<lval> is set then the fetch
258will be part of a store. Make sure the return value is non-null before
259accessing it. The return value when C<tb> is a tied hash is a pointer to a
260static location, so be sure to make a copy of the structure if you need to
1c846c1f 261store it somewhere.
954c1994 262
96f1132b 263See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
954c1994
GS
264information on how to use this function on tied hashes.
265
266=cut
267*/
268
fde52b5c 269HE *
864dbfa3 270Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
fde52b5c 271{
fde52b5c
PP
272 register char *key;
273 STRLEN klen;
274 register HE *entry;
275 SV *sv;
da58a35d 276 bool is_utf8;
f9a63242 277 char *keysave;
fde52b5c
PP
278
279 if (!hv)
280 return 0;
281
902173a3 282 if (SvRMAGICAL(hv)) {
14befaf4 283 if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
902173a3
GS
284 sv = sv_newmortal();
285 keysv = sv_2mortal(newSVsv(keysv));
286 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
3280af22 287 if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
902173a3
GS
288 char *k;
289 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
3280af22 290 HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
902173a3 291 }
3280af22
NIS
292 HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
293 HeVAL(&PL_hv_fetch_ent_mh) = sv;
294 return &PL_hv_fetch_ent_mh;
1cf368ac 295 }
902173a3 296#ifdef ENV_IS_CASELESS
14befaf4 297 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
e7152ba2 298 U32 i;
902173a3 299 key = SvPV(keysv, klen);
e7152ba2
GS
300 for (i = 0; i < klen; ++i)
301 if (isLOWER(key[i])) {
79cb57f6 302 SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
e7152ba2
GS
303 (void)strupr(SvPVX(nkeysv));
304 entry = hv_fetch_ent(hv, nkeysv, 0, 0);
305 if (!entry && lval)
306 entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
307 return entry;
308 }
902173a3
GS
309 }
310#endif
fde52b5c
PP
311 }
312
cdff3ec0 313 if (!HvARRAY(hv)) {
1c846c1f 314 if (lval
fde52b5c 315#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
a3f1c6fb 316 || mg_find((SV*)hv, PERL_MAGIC_env)
fde52b5c
PP
317#endif
318 )
cdff3ec0 319 Newz(503, HvARRAY(hv),
b72a5635 320 PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1), HE*);
fde52b5c
PP
321 else
322 return 0;
323 }
324
f9a63242 325 keysave = key = SvPV(keysv, klen);
da58a35d 326 is_utf8 = (SvUTF8(keysv)!=0);
1c846c1f 327
f9a63242
JH
328 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
329 key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
330
effa1e2d
PP
331 if (!hash)
332 PERL_HASH(hash, key, klen);
333
cdff3ec0 334 entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
fde52b5c
PP
335 for (; entry; entry = HeNEXT(entry)) {
336 if (HeHASH(entry) != hash) /* strings can't be equal */
337 continue;
338 if (HeKLEN(entry) != klen)
339 continue;
1c846c1f 340 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c 341 continue;
c3654f1a
IH
342 if (HeKUTF8(entry) != (char)is_utf8)
343 continue;
f9a63242
JH
344 if (key != keysave)
345 Safefree(key);
fde52b5c
PP
346 return entry;
347 }
348#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
a3f1c6fb 349 if (mg_find((SV*)hv, PERL_MAGIC_env)) {
a6c40364
GS
350 unsigned long len;
351 char *env = PerlEnv_ENVgetenv_len(key,&len);
352 if (env) {
353 sv = newSVpvn(env,len);
354 SvTAINTED_on(sv);
355 return hv_store_ent(hv,keysv,sv,hash);
356 }
fde52b5c
PP
357 }
358#endif
f9a63242
JH
359 if (key != keysave)
360 Safefree(key);
fde52b5c
PP
361 if (lval) { /* gonna assign to this, so it better be there */
362 sv = NEWSV(61,0);
e7152ba2 363 return hv_store_ent(hv,keysv,sv,hash);
fde52b5c
PP
364 }
365 return 0;
366}
367
864dbfa3 368STATIC void
cea2e8a9 369S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
d0066dc7
OT
370{
371 MAGIC *mg = SvMAGIC(hv);
372 *needs_copy = FALSE;
373 *needs_store = TRUE;
374 while (mg) {
375 if (isUPPER(mg->mg_type)) {
376 *needs_copy = TRUE;
377 switch (mg->mg_type) {
14befaf4
DM
378 case PERL_MAGIC_tied:
379 case PERL_MAGIC_sig:
d0066dc7 380 *needs_store = FALSE;
d0066dc7
OT
381 }
382 }
383 mg = mg->mg_moremagic;
384 }
385}
386
954c1994
GS
387/*
388=for apidoc hv_store
389
390Stores an SV in a hash. The hash key is specified as C<key> and C<klen> is
391the length of the key. The C<hash> parameter is the precomputed hash
392value; if it is zero then Perl will compute it. The return value will be
393NULL if the operation failed or if the value did not need to be actually
394stored within the hash (as in the case of tied hashes). Otherwise it can
395be dereferenced to get the original C<SV*>. Note that the caller is
396responsible for suitably incrementing the reference count of C<val> before
1c846c1f 397the call, and decrementing it if the function returned NULL.
954c1994 398
96f1132b 399See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
954c1994
GS
400information on how to use this function on tied hashes.
401
402=cut
403*/
404
79072805 405SV**
da58a35d 406Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash)
79072805 407{
79072805
LW
408 register I32 i;
409 register HE *entry;
410 register HE **oentry;
da58a35d 411 bool is_utf8 = FALSE;
f9a63242 412 const char *keysave = key;
79072805
LW
413
414 if (!hv)
415 return 0;
416
da58a35d
JH
417 if (klen < 0) {
418 klen = -klen;
419 is_utf8 = TRUE;
420 }
421
463ee0b2 422 if (SvMAGICAL(hv)) {
d0066dc7
OT
423 bool needs_copy;
424 bool needs_store;
425 hv_magic_check (hv, &needs_copy, &needs_store);
426 if (needs_copy) {
427 mg_copy((SV*)hv, val, key, klen);
cdff3ec0 428 if (!HvARRAY(hv) && !needs_store)
d0066dc7 429 return 0;
902173a3 430#ifdef ENV_IS_CASELESS
14befaf4 431 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
d220deaf
VK
432 key = savepvn(key,klen);
433 key = strupr(key);
902173a3
GS
434 hash = 0;
435 }
436#endif
d0066dc7 437 }
463ee0b2 438 }
75a54232
JH
439 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
440 STRLEN tmplen = klen;
441 /* See the note in hv_fetch(). --jhi */
442 key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
443 klen = tmplen;
444 }
f9a63242 445
fde52b5c
PP
446 if (!hash)
447 PERL_HASH(hash, key, klen);
448
cdff3ec0
AMS
449 if (!HvARRAY(hv))
450 Newz(505, HvARRAY(hv),
b72a5635 451 PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1), HE*);
fde52b5c 452
cdff3ec0 453 oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
fde52b5c
PP
454 i = 1;
455
456 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
457 if (HeHASH(entry) != hash) /* strings can't be equal */
458 continue;
459 if (HeKLEN(entry) != klen)
460 continue;
1c846c1f 461 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c 462 continue;
c3654f1a
IH
463 if (HeKUTF8(entry) != (char)is_utf8)
464 continue;
fde52b5c
PP
465 SvREFCNT_dec(HeVAL(entry));
466 HeVAL(entry) = val;
f9a63242
JH
467 if (key != keysave)
468 Safefree(key);
fde52b5c
PP
469 return &HeVAL(entry);
470 }
471
d33b2eba 472 entry = new_HE();
fde52b5c 473 if (HvSHAREKEYS(hv))
c3654f1a 474 HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
fde52b5c 475 else /* gotta do the real thing */
c3654f1a 476 HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
f9a63242
JH
477 if (key != keysave)
478 Safefree(key);
fde52b5c 479 HeVAL(entry) = val;
fde52b5c
PP
480 HeNEXT(entry) = *oentry;
481 *oentry = entry;
482
cdff3ec0 483 HvKEYS(hv)++;
fde52b5c 484 if (i) { /* initial entry? */
cdff3ec0
AMS
485 HvFILL(hv)++;
486 if (HvKEYS(hv) > HvMAX(hv))
fde52b5c 487 hsplit(hv);
79072805
LW
488 }
489
fde52b5c
PP
490 return &HeVAL(entry);
491}
492
954c1994
GS
493/*
494=for apidoc hv_store_ent
495
496Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash>
497parameter is the precomputed hash value; if it is zero then Perl will
498compute it. The return value is the new hash entry so created. It will be
499NULL if the operation failed or if the value did not need to be actually
500stored within the hash (as in the case of tied hashes). Otherwise the
87324b0f 501contents of the return value can be accessed using the C<He?> macros
954c1994
GS
502described here. Note that the caller is responsible for suitably
503incrementing the reference count of C<val> before the call, and
1c846c1f 504decrementing it if the function returned NULL.
954c1994 505
96f1132b 506See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
954c1994
GS
507information on how to use this function on tied hashes.
508
509=cut
510*/
511
fde52b5c 512HE *
864dbfa3 513Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
fde52b5c 514{
fde52b5c
PP
515 register char *key;
516 STRLEN klen;
517 register I32 i;
518 register HE *entry;
519 register HE **oentry;
da58a35d 520 bool is_utf8;
f9a63242 521 char *keysave;
fde52b5c
PP
522
523 if (!hv)
524 return 0;
525
fde52b5c 526 if (SvMAGICAL(hv)) {
d0066dc7
OT
527 bool needs_copy;
528 bool needs_store;
529 hv_magic_check (hv, &needs_copy, &needs_store);
530 if (needs_copy) {
3280af22
NIS
531 bool save_taint = PL_tainted;
532 if (PL_tainting)
533 PL_tainted = SvTAINTED(keysv);
d0066dc7
OT
534 keysv = sv_2mortal(newSVsv(keysv));
535 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
536 TAINT_IF(save_taint);
cdff3ec0 537 if (!HvARRAY(hv) && !needs_store)
d0066dc7 538 return Nullhe;
902173a3 539#ifdef ENV_IS_CASELESS
14befaf4 540 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
902173a3 541 key = SvPV(keysv, klen);
79cb57f6 542 keysv = sv_2mortal(newSVpvn(key,klen));
902173a3
GS
543 (void)strupr(SvPVX(keysv));
544 hash = 0;
545 }
546#endif
547 }
fde52b5c
PP
548 }
549
f9a63242 550 keysave = key = SvPV(keysv, klen);
da58a35d 551 is_utf8 = (SvUTF8(keysv) != 0);
902173a3 552
f9a63242
JH
553 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
554 key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
555
fde52b5c
PP
556 if (!hash)
557 PERL_HASH(hash, key, klen);
558
cdff3ec0
AMS
559 if (!HvARRAY(hv))
560 Newz(505, HvARRAY(hv),
b72a5635 561 PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1), HE*);
79072805 562
cdff3ec0 563 oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
79072805
LW
564 i = 1;
565
fde52b5c
PP
566 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
567 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 568 continue;
fde52b5c 569 if (HeKLEN(entry) != klen)
79072805 570 continue;
1c846c1f 571 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 572 continue;
c3654f1a
IH
573 if (HeKUTF8(entry) != (char)is_utf8)
574 continue;
fde52b5c
PP
575 SvREFCNT_dec(HeVAL(entry));
576 HeVAL(entry) = val;
f9a63242
JH
577 if (key != keysave)
578 Safefree(key);
fde52b5c 579 return entry;
79072805 580 }
79072805 581
d33b2eba 582 entry = new_HE();
fde52b5c 583 if (HvSHAREKEYS(hv))
c3654f1a 584 HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
fde52b5c 585 else /* gotta do the real thing */
c3654f1a 586 HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
f9a63242
JH
587 if (key != keysave)
588 Safefree(key);
fde52b5c 589 HeVAL(entry) = val;
fde52b5c 590 HeNEXT(entry) = *oentry;
79072805
LW
591 *oentry = entry;
592
cdff3ec0 593 HvKEYS(hv)++;
79072805 594 if (i) { /* initial entry? */
cdff3ec0
AMS
595 HvFILL(hv)++;
596 if (HvKEYS(hv) > HvMAX(hv))
79072805
LW
597 hsplit(hv);
598 }
79072805 599
fde52b5c 600 return entry;
79072805
LW
601}
602
954c1994
GS
603/*
604=for apidoc hv_delete
605
606Deletes a key/value pair in the hash. The value SV is removed from the
1c846c1f 607hash and returned to the caller. The C<klen> is the length of the key.
954c1994
GS
608The C<flags> value will normally be zero; if set to G_DISCARD then NULL
609will be returned.
610
611=cut
612*/
613
79072805 614SV *
da58a35d 615Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
79072805 616{
79072805 617 register I32 i;
fde52b5c 618 register U32 hash;
79072805
LW
619 register HE *entry;
620 register HE **oentry;
67a38de0 621 SV **svp;
79072805 622 SV *sv;
da58a35d 623 bool is_utf8 = FALSE;
f9a63242 624 const char *keysave = key;
79072805
LW
625
626 if (!hv)
627 return Nullsv;
da58a35d
JH
628 if (klen < 0) {
629 klen = -klen;
630 is_utf8 = TRUE;
631 }
8990e307 632 if (SvRMAGICAL(hv)) {
0a0bb7c7
OT
633 bool needs_copy;
634 bool needs_store;
635 hv_magic_check (hv, &needs_copy, &needs_store);
636
67a38de0
NIS
637 if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
638 sv = *svp;
0a0bb7c7
OT
639 mg_clear(sv);
640 if (!needs_store) {
14befaf4
DM
641 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
642 /* No longer an element */
643 sv_unmagic(sv, PERL_MAGIC_tiedelem);
0a0bb7c7
OT
644 return sv;
645 }
646 return Nullsv; /* element cannot be deleted */
647 }
902173a3 648#ifdef ENV_IS_CASELESS
14befaf4 649 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
79cb57f6 650 sv = sv_2mortal(newSVpvn(key,klen));
2fd1c6b8
GS
651 key = strupr(SvPVX(sv));
652 }
902173a3 653#endif
2fd1c6b8 654 }
463ee0b2 655 }
cdff3ec0 656 if (!HvARRAY(hv))
79072805 657 return Nullsv;
fde52b5c 658
75a54232
JH
659 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
660 STRLEN tmplen = klen;
661 /* See the note in hv_fetch(). --jhi */
662 key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
663 klen = tmplen;
664 }
f9a63242 665
fde52b5c 666 PERL_HASH(hash, key, klen);
79072805 667
cdff3ec0 668 oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
79072805
LW
669 entry = *oentry;
670 i = 1;
fde52b5c
PP
671 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
672 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 673 continue;
fde52b5c 674 if (HeKLEN(entry) != klen)
79072805 675 continue;
1c846c1f 676 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 677 continue;
c3654f1a
IH
678 if (HeKUTF8(entry) != (char)is_utf8)
679 continue;
f9a63242
JH
680 if (key != keysave)
681 Safefree(key);
fde52b5c 682 *oentry = HeNEXT(entry);
79072805 683 if (i && !*oentry)
cdff3ec0 684 HvFILL(hv)--;
748a9306
LW
685 if (flags & G_DISCARD)
686 sv = Nullsv;
94f7643d 687 else {
79d01fbf 688 sv = sv_2mortal(HeVAL(entry));
94f7643d
GS
689 HeVAL(entry) = &PL_sv_undef;
690 }
cdff3ec0 691 if (entry == HvEITER(hv))
72940dca 692 HvLAZYDEL_on(hv);
a0d0e21e 693 else
68dc0745 694 hv_free_ent(hv, entry);
cdff3ec0 695 HvKEYS(hv)--;
fde52b5c
PP
696 return sv;
697 }
f9a63242
JH
698 if (key != keysave)
699 Safefree(key);
fde52b5c
PP
700 return Nullsv;
701}
702
954c1994
GS
703/*
704=for apidoc hv_delete_ent
705
706Deletes a key/value pair in the hash. The value SV is removed from the
707hash and returned to the caller. The C<flags> value will normally be zero;
708if set to G_DISCARD then NULL will be returned. C<hash> can be a valid
709precomputed hash value, or 0 to ask for it to be computed.
710
711=cut
712*/
713
fde52b5c 714SV *
864dbfa3 715Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
fde52b5c 716{
fde52b5c
PP
717 register I32 i;
718 register char *key;
719 STRLEN klen;
720 register HE *entry;
721 register HE **oentry;
722 SV *sv;
da58a35d 723 bool is_utf8;
f9a63242 724 char *keysave;
1c846c1f 725
fde52b5c
PP
726 if (!hv)
727 return Nullsv;
728 if (SvRMAGICAL(hv)) {
0a0bb7c7
OT
729 bool needs_copy;
730 bool needs_store;
731 hv_magic_check (hv, &needs_copy, &needs_store);
732
67a38de0 733 if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
0a0bb7c7
OT
734 sv = HeVAL(entry);
735 mg_clear(sv);
736 if (!needs_store) {
14befaf4
DM
737 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
738 /* No longer an element */
739 sv_unmagic(sv, PERL_MAGIC_tiedelem);
0a0bb7c7
OT
740 return sv;
741 }
742 return Nullsv; /* element cannot be deleted */
743 }
902173a3 744#ifdef ENV_IS_CASELESS
14befaf4 745 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
2fd1c6b8 746 key = SvPV(keysv, klen);
79cb57f6 747 keysv = sv_2mortal(newSVpvn(key,klen));
2fd1c6b8 748 (void)strupr(SvPVX(keysv));
1c846c1f 749 hash = 0;
2fd1c6b8 750 }
902173a3 751#endif
2fd1c6b8 752 }
fde52b5c 753 }
cdff3ec0 754 if (!HvARRAY(hv))
fde52b5c
PP
755 return Nullsv;
756
f9a63242 757 keysave = key = SvPV(keysv, klen);
da58a35d 758 is_utf8 = (SvUTF8(keysv) != 0);
1c846c1f 759
f9a63242
JH
760 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
761 key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
762
fde52b5c
PP
763 if (!hash)
764 PERL_HASH(hash, key, klen);
765
cdff3ec0 766 oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
fde52b5c
PP
767 entry = *oentry;
768 i = 1;
769 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
770 if (HeHASH(entry) != hash) /* strings can't be equal */
771 continue;
772 if (HeKLEN(entry) != klen)
773 continue;
1c846c1f 774 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c 775 continue;
c3654f1a
IH
776 if (HeKUTF8(entry) != (char)is_utf8)
777 continue;
f9a63242
JH
778 if (key != keysave)
779 Safefree(key);
fde52b5c
PP
780 *oentry = HeNEXT(entry);
781 if (i && !*oentry)
cdff3ec0 782 HvFILL(hv)--;
fde52b5c
PP
783 if (flags & G_DISCARD)
784 sv = Nullsv;
94f7643d 785 else {
79d01fbf 786 sv = sv_2mortal(HeVAL(entry));
94f7643d
GS
787 HeVAL(entry) = &PL_sv_undef;
788 }
cdff3ec0 789 if (entry == HvEITER(hv))
72940dca 790 HvLAZYDEL_on(hv);
fde52b5c 791 else
68dc0745 792 hv_free_ent(hv, entry);
cdff3ec0 793 HvKEYS(hv)--;
79072805
LW
794 return sv;
795 }
f9a63242
JH
796 if (key != keysave)
797 Safefree(key);
79072805 798 return Nullsv;
79072805
LW
799}
800
954c1994
GS
801/*
802=for apidoc hv_exists
803
804Returns a boolean indicating whether the specified hash key exists. The
805C<klen> is the length of the key.
806
807=cut
808*/
809
a0d0e21e 810bool
da58a35d 811Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
a0d0e21e 812{
fde52b5c 813 register U32 hash;
a0d0e21e
LW
814 register HE *entry;
815 SV *sv;
da58a35d 816 bool is_utf8 = FALSE;
f9a63242 817 const char *keysave = key;
a0d0e21e
LW
818
819 if (!hv)
820 return 0;
821
da58a35d
JH
822 if (klen < 0) {
823 klen = -klen;
824 is_utf8 = TRUE;
825 }
826
a0d0e21e 827 if (SvRMAGICAL(hv)) {
14befaf4 828 if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
a0d0e21e 829 sv = sv_newmortal();
1c846c1f 830 mg_copy((SV*)hv, sv, key, klen);
14befaf4 831 magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
a0d0e21e
LW
832 return SvTRUE(sv);
833 }
902173a3 834#ifdef ENV_IS_CASELESS
14befaf4 835 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
79cb57f6 836 sv = sv_2mortal(newSVpvn(key,klen));
902173a3
GS
837 key = strupr(SvPVX(sv));
838 }
839#endif
a0d0e21e
LW
840 }
841
f675dbe5 842#ifndef DYNAMIC_ENV_FETCH
cdff3ec0 843 if (!HvARRAY(hv))
1c846c1f 844 return 0;
f675dbe5 845#endif
a0d0e21e 846
75a54232
JH
847 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
848 STRLEN tmplen = klen;
849 /* See the note in hv_fetch(). --jhi */
850 key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
851 klen = tmplen;
852 }
f9a63242 853
fde52b5c 854 PERL_HASH(hash, key, klen);
a0d0e21e 855
f675dbe5 856#ifdef DYNAMIC_ENV_FETCH
cdff3ec0 857 if (!HvARRAY(hv)) entry = Null(HE*);
f675dbe5
CB
858 else
859#endif
cdff3ec0 860 entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
fde52b5c
PP
861 for (; entry; entry = HeNEXT(entry)) {
862 if (HeHASH(entry) != hash) /* strings can't be equal */
a0d0e21e 863 continue;
fde52b5c 864 if (HeKLEN(entry) != klen)
a0d0e21e 865 continue;
1c846c1f 866 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c 867 continue;
c3654f1a
IH
868 if (HeKUTF8(entry) != (char)is_utf8)
869 continue;
f9a63242
JH
870 if (key != keysave)
871 Safefree(key);
fde52b5c
PP
872 return TRUE;
873 }
f675dbe5 874#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
a3f1c6fb 875 if (mg_find((SV*)hv, PERL_MAGIC_env)) {
a6c40364
GS
876 unsigned long len;
877 char *env = PerlEnv_ENVgetenv_len(key,&len);
878 if (env) {
879 sv = newSVpvn(env,len);
880 SvTAINTED_on(sv);
881 (void)hv_store(hv,key,klen,sv,hash);
882 return TRUE;
883 }
f675dbe5
CB
884 }
885#endif
f9a63242
JH
886 if (key != keysave)
887 Safefree(key);
fde52b5c
PP
888 return FALSE;
889}
890
891
954c1994
GS
892/*
893=for apidoc hv_exists_ent
894
895Returns a boolean indicating whether the specified hash key exists. C<hash>
896can be a valid precomputed hash value, or 0 to ask for it to be
897computed.
898
899=cut
900*/
901
fde52b5c 902bool
864dbfa3 903Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
fde52b5c 904{
fde52b5c
PP
905 register char *key;
906 STRLEN klen;
907 register HE *entry;
908 SV *sv;
c3654f1a 909 bool is_utf8;
f9a63242 910 char *keysave;
fde52b5c
PP
911
912 if (!hv)
913 return 0;
914
915 if (SvRMAGICAL(hv)) {
14befaf4 916 if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
62815d3c 917 SV* svret = sv_newmortal();
fde52b5c 918 sv = sv_newmortal();
effa1e2d 919 keysv = sv_2mortal(newSVsv(keysv));
1c846c1f 920 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
14befaf4 921 magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
62815d3c 922 return SvTRUE(svret);
fde52b5c 923 }
902173a3 924#ifdef ENV_IS_CASELESS
14befaf4 925 else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
902173a3 926 key = SvPV(keysv, klen);
79cb57f6 927 keysv = sv_2mortal(newSVpvn(key,klen));
902173a3 928 (void)strupr(SvPVX(keysv));
1c846c1f 929 hash = 0;
902173a3
GS
930 }
931#endif
fde52b5c
PP
932 }
933
f675dbe5 934#ifndef DYNAMIC_ENV_FETCH
cdff3ec0 935 if (!HvARRAY(hv))
1c846c1f 936 return 0;
f675dbe5 937#endif
fde52b5c 938
f9a63242 939 keysave = key = SvPV(keysv, klen);
c3654f1a 940 is_utf8 = (SvUTF8(keysv) != 0);
f9a63242
JH
941 if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
942 key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
fde52b5c
PP
943 if (!hash)
944 PERL_HASH(hash, key, klen);
945
f675dbe5 946#ifdef DYNAMIC_ENV_FETCH
cdff3ec0 947 if (!HvARRAY(hv)) entry = Null(HE*);
f675dbe5
CB
948 else
949#endif
cdff3ec0 950 entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
fde52b5c
PP
951 for (; entry; entry = HeNEXT(entry)) {
952 if (HeHASH(entry) != hash) /* strings can't be equal */
953 continue;
954 if (HeKLEN(entry) != klen)
955 continue;
1c846c1f 956 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
a0d0e21e 957 continue;
c3654f1a
IH
958 if (HeKUTF8(entry) != (char)is_utf8)
959 continue;
f9a63242
JH
960 if (key != keysave)
961 Safefree(key);
a0d0e21e
LW
962 return TRUE;
963 }
f675dbe5 964#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
a3f1c6fb 965 if (mg_find((SV*)hv, PERL_MAGIC_env)) {
a6c40364
GS
966 unsigned long len;
967 char *env = PerlEnv_ENVgetenv_len(key,&len);
968 if (env) {
969 sv = newSVpvn(env,len);
970 SvTAINTED_on(sv);
971 (void)hv_store_ent(hv,keysv,sv,hash);
972 return TRUE;
973 }
f675dbe5
CB
974 }
975#endif
f9a63242
JH
976 if (key != keysave)
977 Safefree(key);
a0d0e21e
LW
978 return FALSE;
979}
980
76e3520e 981STATIC void
cea2e8a9 982S_hsplit(pTHX_ HV *hv)
79072805 983{
cdff3ec0 984 I32 oldsize = (I32) HvMAX(hv) + 1; /* sic(k) */
79072805
LW
985 register I32 newsize = oldsize * 2;
986 register I32 i;
cdff3ec0 987 register char *a = (char *)HvARRAY(hv);
72311751
GS
988 register HE **aep;
989 register HE **bep;
79072805
LW
990 register HE *entry;
991 register HE **oentry;
992
3280af22 993 PL_nomemok = TRUE;
8d6dde3e 994#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
d18c6117 995 Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 996 if (!a) {
4a33f861 997 PL_nomemok = FALSE;
422a93e5
GA
998 return;
999 }
4633a7c4 1000#else
d18c6117 1001 New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 1002 if (!a) {
3280af22 1003 PL_nomemok = FALSE;
422a93e5
GA
1004 return;
1005 }
cdff3ec0 1006 Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
fba3b22e 1007 if (oldsize >= 64) {
cdff3ec0 1008 offer_nice_chunk(HvARRAY(hv), PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
4633a7c4
LW
1009 }
1010 else
cdff3ec0 1011 Safefree(HvARRAY(hv));
4633a7c4
LW
1012#endif
1013
3280af22 1014 PL_nomemok = FALSE;
72311751 1015 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
cdff3ec0 1016 HvMAX(hv) = --newsize;
b72a5635 1017 HvARRAY(hv) = (HE**)a;
72311751 1018 aep = (HE**)a;
79072805 1019
72311751
GS
1020 for (i=0; i<oldsize; i++,aep++) {
1021 if (!*aep) /* non-existent */
79072805 1022 continue;
72311751
GS
1023 bep = aep+oldsize;
1024 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
fde52b5c
PP
1025 if ((HeHASH(entry) & newsize) != i) {
1026 *oentry = HeNEXT(entry);
72311751
GS
1027 HeNEXT(entry) = *bep;
1028 if (!*bep)
cdff3ec0 1029 HvFILL(hv)++;
72311751 1030 *bep = entry;
79072805
LW
1031 continue;
1032 }
1033 else
fde52b5c 1034 oentry = &HeNEXT(entry);
79072805 1035 }
72311751 1036 if (!*aep) /* everything moved */
cdff3ec0 1037 HvFILL(hv)--;
79072805
LW
1038 }
1039}
1040
72940dca 1041void
864dbfa3 1042Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
72940dca 1043{
cdff3ec0 1044 I32 oldsize = (I32) HvMAX(hv) + 1; /* sic(k) */
72940dca
PP
1045 register I32 newsize;
1046 register I32 i;
1047 register I32 j;
72311751
GS
1048 register char *a;
1049 register HE **aep;
72940dca
PP
1050 register HE *entry;
1051 register HE **oentry;
1052
1053 newsize = (I32) newmax; /* possible truncation here */
1054 if (newsize != newmax || newmax <= oldsize)
1055 return;
1056 while ((newsize & (1 + ~newsize)) != newsize) {
1057 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
1058 }
1059 if (newsize < newmax)
1060 newsize *= 2;
1061 if (newsize < newmax)
1062 return; /* overflow detection */
1063
cdff3ec0 1064 a = (char *)HvARRAY(hv);
72940dca 1065 if (a) {
3280af22 1066 PL_nomemok = TRUE;
8d6dde3e 1067#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
d18c6117 1068 Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 1069 if (!a) {
4a33f861 1070 PL_nomemok = FALSE;
422a93e5
GA
1071 return;
1072 }
72940dca 1073#else
d18c6117 1074 New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 1075 if (!a) {
3280af22 1076 PL_nomemok = FALSE;
422a93e5
GA
1077 return;
1078 }
cdff3ec0 1079 Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
fba3b22e 1080 if (oldsize >= 64) {
cdff3ec0 1081 offer_nice_chunk(HvARRAY(hv), PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
72940dca
PP
1082 }
1083 else
cdff3ec0 1084 Safefree(HvARRAY(hv));
72940dca 1085#endif
3280af22 1086 PL_nomemok = FALSE;
72311751 1087 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
72940dca
PP
1088 }
1089 else {
d18c6117 1090 Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
72940dca 1091 }
cdff3ec0 1092 HvMAX(hv) = --newsize;
b72a5635 1093 HvARRAY(hv) = (HE**)a;
cdff3ec0 1094 if (!HvFILL(hv)) /* skip rest if no entries */
72940dca
PP
1095 return;
1096
72311751
GS
1097 aep = (HE**)a;
1098 for (i=0; i<oldsize; i++,aep++) {
1099 if (!*aep) /* non-existent */
72940dca 1100 continue;
72311751 1101 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
72940dca
PP
1102 if ((j = (HeHASH(entry) & newsize)) != i) {
1103 j -= i;
1104 *oentry = HeNEXT(entry);
72311751 1105 if (!(HeNEXT(entry) = aep[j]))
cdff3ec0 1106 HvFILL(hv)++;
72311751 1107 aep[j] = entry;
72940dca
PP
1108 continue;
1109 }
1110 else
1111 oentry = &HeNEXT(entry);
1112 }
72311751 1113 if (!*aep) /* everything moved */
cdff3ec0 1114 HvFILL(hv)--;
72940dca
PP
1115 }
1116}
1117
954c1994
GS
1118/*
1119=for apidoc newHV
1120
1121Creates a new HV. The reference count is set to 1.
1122
1123=cut
1124*/
1125
79072805 1126HV *
864dbfa3 1127Perl_newHV(pTHX)
79072805
LW
1128{
1129 register HV *hv;
79072805 1130
a0d0e21e
LW
1131 hv = (HV*)NEWSV(502,0);
1132 sv_upgrade((SV *)hv, SVt_PVHV);
79072805
LW
1133 SvPOK_off(hv);
1134 SvNOK_off(hv);
1c846c1f 1135#ifndef NODEFAULT_SHAREKEYS
fde52b5c 1136 HvSHAREKEYS_on(hv); /* key-sharing on by default */
1c846c1f 1137#endif
cdff3ec0
AMS
1138 HvMAX(hv) = 7; /* start with 8 buckets */
1139 HvFILL(hv) = 0;
1140 HvPMROOT(hv) = 0;
79072805
LW
1141 (void)hv_iterinit(hv); /* so each() will start off right */
1142 return hv;
1143}
1144
b3ac6de7 1145HV *
864dbfa3 1146Perl_newHVhv(pTHX_ HV *ohv)
b3ac6de7
IZ
1147{
1148 register HV *hv;
b3ac6de7
IZ
1149 STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
1150 STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
1151
1152 hv = newHV();
1153 while (hv_max && hv_max + 1 >= hv_fill * 2)
1154 hv_max = hv_max / 2; /* Is always 2^n-1 */
4a76a316 1155 HvMAX(hv) = hv_max;
b3ac6de7
IZ
1156 if (!hv_fill)
1157 return hv;
1158
1159#if 0
14befaf4 1160 if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) {
b3ac6de7 1161 /* Quick way ???*/
1c846c1f
NIS
1162 }
1163 else
b3ac6de7
IZ
1164#endif
1165 {
1166 HE *entry;
1167 I32 hv_riter = HvRITER(ohv); /* current root of iterator */
1168 HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
1169
1170 /* Slow way */
4a76a316 1171 hv_iterinit(ohv);
155aba94 1172 while ((entry = hv_iternext(ohv))) {
c3654f1a 1173 hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
00122d59 1174 newSVsv(HeVAL(entry)), HeHASH(entry));
b3ac6de7
IZ
1175 }
1176 HvRITER(ohv) = hv_riter;
1177 HvEITER(ohv) = hv_eiter;
1178 }
1c846c1f 1179
b3ac6de7
IZ
1180 return hv;
1181}
1182
79072805 1183void
864dbfa3 1184Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
79072805 1185{
16bdeea2
GS
1186 SV *val;
1187
68dc0745 1188 if (!entry)
79072805 1189 return;
16bdeea2 1190 val = HeVAL(entry);
257c9e5b 1191 if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
3280af22 1192 PL_sub_generation++; /* may be deletion of method from stash */
16bdeea2 1193 SvREFCNT_dec(val);
68dc0745
PP
1194 if (HeKLEN(entry) == HEf_SVKEY) {
1195 SvREFCNT_dec(HeKEY_sv(entry));
1196 Safefree(HeKEY_hek(entry));
44a8e56a
PP
1197 }
1198 else if (HvSHAREKEYS(hv))
68dc0745 1199 unshare_hek(HeKEY_hek(entry));
fde52b5c 1200 else
68dc0745 1201 Safefree(HeKEY_hek(entry));
d33b2eba 1202 del_HE(entry);
79072805
LW
1203}
1204
1205void
864dbfa3 1206Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
79072805 1207{
68dc0745 1208 if (!entry)
79072805 1209 return;
68dc0745 1210 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
3280af22 1211 PL_sub_generation++; /* may be deletion of method from stash */
68dc0745
PP
1212 sv_2mortal(HeVAL(entry)); /* free between statements */
1213 if (HeKLEN(entry) == HEf_SVKEY) {
1214 sv_2mortal(HeKEY_sv(entry));
1215 Safefree(HeKEY_hek(entry));
44a8e56a
PP
1216 }
1217 else if (HvSHAREKEYS(hv))
68dc0745 1218 unshare_hek(HeKEY_hek(entry));
fde52b5c 1219 else
68dc0745 1220 Safefree(HeKEY_hek(entry));
d33b2eba 1221 del_HE(entry);
79072805
LW
1222}
1223
954c1994
GS
1224/*
1225=for apidoc hv_clear
1226
1227Clears a hash, making it empty.
1228
1229=cut
1230*/
1231
79072805 1232void
864dbfa3 1233Perl_hv_clear(pTHX_ HV *hv)
79072805 1234{
79072805
LW
1235 if (!hv)
1236 return;
463ee0b2 1237 hfreeentries(hv);
cdff3ec0
AMS
1238 HvFILL(hv) = 0;
1239 HvKEYS(hv) = 0;
1240 if (HvARRAY(hv))
1241 (void)memzero(HvARRAY(hv), (HvMAX(hv) + 1) * sizeof(HE*));
a0d0e21e
LW
1242
1243 if (SvRMAGICAL(hv))
1c846c1f 1244 mg_clear((SV*)hv);
79072805
LW
1245}
1246
76e3520e 1247STATIC void
cea2e8a9 1248S_hfreeentries(pTHX_ HV *hv)
79072805 1249{
a0d0e21e 1250 register HE **array;
68dc0745
PP
1251 register HE *entry;
1252 register HE *oentry = Null(HE*);
a0d0e21e
LW
1253 I32 riter;
1254 I32 max;
79072805
LW
1255
1256 if (!hv)
1257 return;
a0d0e21e 1258 if (!HvARRAY(hv))
79072805 1259 return;
a0d0e21e
LW
1260
1261 riter = 0;
1262 max = HvMAX(hv);
1263 array = HvARRAY(hv);
68dc0745 1264 entry = array[0];
a0d0e21e 1265 for (;;) {
68dc0745
PP
1266 if (entry) {
1267 oentry = entry;
1268 entry = HeNEXT(entry);
1269 hv_free_ent(hv, oentry);
a0d0e21e 1270 }
68dc0745 1271 if (!entry) {
a0d0e21e
LW
1272 if (++riter > max)
1273 break;
68dc0745 1274 entry = array[riter];
1c846c1f 1275 }
79072805 1276 }
a0d0e21e 1277 (void)hv_iterinit(hv);
79072805
LW
1278}
1279
954c1994
GS
1280/*
1281=for apidoc hv_undef
1282
1283Undefines the hash.
1284
1285=cut
1286*/
1287
79072805 1288void
864dbfa3 1289Perl_hv_undef(pTHX_ HV *hv)
79072805 1290{
79072805
LW
1291 if (!hv)
1292 return;
463ee0b2 1293 hfreeentries(hv);
cdff3ec0 1294 Safefree(HvARRAY(hv));
85e6fe83
LW
1295 if (HvNAME(hv)) {
1296 Safefree(HvNAME(hv));
1297 HvNAME(hv) = 0;
1298 }
cdff3ec0
AMS
1299 HvARRAY(hv) = 0;
1300 HvMAX(hv) = 7; /* it's a normal hash */
1301 HvFILL(hv) = 0;
1302 HvKEYS(hv) = 0;
a0d0e21e
LW
1303
1304 if (SvRMAGICAL(hv))
1c846c1f 1305 mg_clear((SV*)hv);
79072805
LW
1306}
1307
954c1994
GS
1308/*
1309=for apidoc hv_iterinit
1310
1311Prepares a starting point to traverse a hash table. Returns the number of
1312keys in the hash (i.e. the same as C<HvKEYS(tb)>). The return value is
1c846c1f 1313currently only meaningful for hashes without tie magic.
954c1994
GS
1314
1315NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
1316hash buckets that happen to be in use. If you still need that esoteric
1317value, you can get it through the macro C<HvFILL(tb)>.
1318
1319=cut
1320*/
1321
79072805 1322I32
864dbfa3 1323Perl_hv_iterinit(pTHX_ HV *hv)
79072805 1324{
aa689395
PP
1325 HE *entry;
1326
1327 if (!hv)
cea2e8a9 1328 Perl_croak(aTHX_ "Bad hash");
cdff3ec0 1329 entry = HvEITER(hv);
72940dca
PP
1330 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
1331 HvLAZYDEL_off(hv);
68dc0745 1332 hv_free_ent(hv, entry);
72940dca 1333 }
cdff3ec0
AMS
1334 HvRITER(hv) = -1;
1335 HvEITER(hv) = Null(HE*);
1336 return HvKEYS(hv); /* used to be xhv->xhv_fill before 5.004_65 */
79072805
LW
1337}
1338
954c1994
GS
1339/*
1340=for apidoc hv_iternext
1341
1342Returns entries from a hash iterator. See C<hv_iterinit>.
1343
1344=cut
1345*/
1346
79072805 1347HE *
864dbfa3 1348Perl_hv_iternext(pTHX_ HV *hv)
79072805 1349{
79072805 1350 register HE *entry;
a0d0e21e 1351 HE *oldentry;
463ee0b2 1352 MAGIC* mg;
79072805
LW
1353
1354 if (!hv)
cea2e8a9 1355 Perl_croak(aTHX_ "Bad hash");
cdff3ec0 1356 oldentry = entry = HvEITER(hv);
463ee0b2 1357
14befaf4 1358 if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
8990e307 1359 SV *key = sv_newmortal();
cd1469e6 1360 if (entry) {
fde52b5c 1361 sv_setsv(key, HeSVKEY_force(entry));
cd1469e6
PP
1362 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
1363 }
a0d0e21e 1364 else {
ff68c719 1365 char *k;
bbce6d69 1366 HEK *hek;
ff68c719 1367
cdff3ec0 1368 HvEITER(hv) = entry = new_HE(); /* one HE per MAGICAL hash */
4633a7c4 1369 Zero(entry, 1, HE);
ff68c719
PP
1370 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
1371 hek = (HEK*)k;
1372 HeKEY_hek(entry) = hek;
fde52b5c 1373 HeKLEN(entry) = HEf_SVKEY;
a0d0e21e
LW
1374 }
1375 magic_nextpack((SV*) hv,mg,key);
463ee0b2 1376 if (SvOK(key)) {
cd1469e6 1377 /* force key to stay around until next time */
bbce6d69
PP
1378 HeSVKEY_set(entry, SvREFCNT_inc(key));
1379 return entry; /* beware, hent_val is not set */
463ee0b2 1380 }
fde52b5c
PP
1381 if (HeVAL(entry))
1382 SvREFCNT_dec(HeVAL(entry));
ff68c719 1383 Safefree(HeKEY_hek(entry));
d33b2eba 1384 del_HE(entry);
cdff3ec0 1385 HvEITER(hv) = Null(HE*);
463ee0b2 1386 return Null(HE*);
79072805 1387 }
f675dbe5 1388#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
a3f1c6fb 1389 if (!entry && mg_find((SV*)hv, PERL_MAGIC_env))
f675dbe5
CB
1390 prime_env_iter();
1391#endif
463ee0b2 1392
cdff3ec0
AMS
1393 if (!HvARRAY(hv))
1394 Newz(506, HvARRAY(hv),
b72a5635 1395 PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1), HE*);
fde52b5c
PP
1396 if (entry)
1397 entry = HeNEXT(entry);
1398 while (!entry) {
cdff3ec0
AMS
1399 HvRITER(hv)++;
1400 if (HvRITER(hv) > HvMAX(hv)) {
1401 HvRITER(hv) = -1;
fde52b5c 1402 break;
79072805 1403 }
cdff3ec0 1404 entry = (HvARRAY(hv))[HvRITER(hv)];
fde52b5c 1405 }
79072805 1406
72940dca
PP
1407 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
1408 HvLAZYDEL_off(hv);
68dc0745 1409 hv_free_ent(hv, oldentry);
72940dca 1410 }
a0d0e21e 1411
cdff3ec0 1412 HvEITER(hv) = entry;
79072805
LW
1413 return entry;
1414}
1415
954c1994
GS
1416/*
1417=for apidoc hv_iterkey
1418
1419Returns the key from the current position of the hash iterator. See
1420C<hv_iterinit>.
1421
1422=cut
1423*/
1424
79072805 1425char *
864dbfa3 1426Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
79072805 1427{
fde52b5c 1428 if (HeKLEN(entry) == HEf_SVKEY) {
fb73857a
PP
1429 STRLEN len;
1430 char *p = SvPV(HeKEY_sv(entry), len);
1431 *retlen = len;
1432 return p;
fde52b5c
PP
1433 }
1434 else {
1435 *retlen = HeKLEN(entry);
1436 return HeKEY(entry);
1437 }
1438}
1439
1440/* unlike hv_iterval(), this always returns a mortal copy of the key */
954c1994
GS
1441/*
1442=for apidoc hv_iterkeysv
1443
1444Returns the key as an C<SV*> from the current position of the hash
1445iterator. The return value will always be a mortal copy of the key. Also
1446see C<hv_iterinit>.
1447
1448=cut
1449*/
1450
fde52b5c 1451SV *
864dbfa3 1452Perl_hv_iterkeysv(pTHX_ register HE *entry)
fde52b5c
PP
1453{
1454 if (HeKLEN(entry) == HEf_SVKEY)
bbce6d69 1455 return sv_mortalcopy(HeKEY_sv(entry));
c3654f1a
IH
1456 else
1457 return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
1458 HeKLEN_UTF8(entry), HeHASH(entry)));
79072805
LW
1459}
1460
954c1994
GS
1461/*
1462=for apidoc hv_iterval
1463
1464Returns the value from the current position of the hash iterator. See
1465C<hv_iterkey>.
1466
1467=cut
1468*/
1469
79072805 1470SV *
864dbfa3 1471Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
79072805 1472{
8990e307 1473 if (SvRMAGICAL(hv)) {
14befaf4 1474 if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
8990e307 1475 SV* sv = sv_newmortal();
bbce6d69
PP
1476 if (HeKLEN(entry) == HEf_SVKEY)
1477 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1478 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
463ee0b2
LW
1479 return sv;
1480 }
79072805 1481 }
fde52b5c 1482 return HeVAL(entry);
79072805
LW
1483}
1484
954c1994
GS
1485/*
1486=for apidoc hv_iternextsv
1487
1488Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
1489operation.
1490
1491=cut
1492*/
1493
a0d0e21e 1494SV *
864dbfa3 1495Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
a0d0e21e
LW
1496{
1497 HE *he;
1498 if ( (he = hv_iternext(hv)) == NULL)
1499 return NULL;
1500 *key = hv_iterkey(he, retlen);
1501 return hv_iterval(hv, he);
1502}
1503
954c1994
GS
1504/*
1505=for apidoc hv_magic
1506
1507Adds magic to a hash. See C<sv_magic>.
1508
1509=cut
1510*/
1511
79072805 1512void
864dbfa3 1513Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
79072805 1514{
a0d0e21e 1515 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
79072805 1516}
fde52b5c 1517
bbce6d69 1518char*
864dbfa3 1519Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
bbce6d69 1520{
ff68c719 1521 return HEK_KEY(share_hek(sv, len, hash));
bbce6d69
PP
1522}
1523
1524/* possibly free a shared string if no one has access to it
fde52b5c
PP
1525 * len and hash must both be valid for str.
1526 */
bbce6d69 1527void
864dbfa3 1528Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
fde52b5c 1529{
cdff3ec0 1530 HV *hv;
fde52b5c
PP
1531 register HE *entry;
1532 register HE **oentry;
1533 register I32 i = 1;
1534 I32 found = 0;
c3654f1a 1535 bool is_utf8 = FALSE;
f9a63242 1536 const char *save = str;
c3654f1a
IH
1537
1538 if (len < 0) {
1539 len = -len;
1540 is_utf8 = TRUE;
75a54232
JH
1541 if (!(PL_hints & HINT_UTF8_DISTINCT)) {
1542 STRLEN tmplen = len;
1543 /* See the note in hv_fetch(). --jhi */
1544 str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
1545 len = tmplen;
1546 }
c3654f1a 1547 }
1c846c1f 1548
fde52b5c 1549 /* what follows is the moral equivalent of:
6b88bc9c 1550 if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
bbce6d69 1551 if (--*Svp == Nullsv)
6b88bc9c 1552 hv_delete(PL_strtab, str, len, G_DISCARD, hash);
bbce6d69 1553 } */
fde52b5c 1554 /* assert(xhv_array != 0) */
cdff3ec0 1555 hv = PL_strtab;
5f08fbcd 1556 LOCK_STRTAB_MUTEX;
cdff3ec0 1557 oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
bbce6d69 1558 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
fde52b5c
PP
1559 if (HeHASH(entry) != hash) /* strings can't be equal */
1560 continue;
1561 if (HeKLEN(entry) != len)
1562 continue;
1c846c1f 1563 if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
fde52b5c 1564 continue;
c3654f1a
IH
1565 if (HeKUTF8(entry) != (char)is_utf8)
1566 continue;
fde52b5c 1567 found = 1;
bbce6d69
PP
1568 if (--HeVAL(entry) == Nullsv) {
1569 *oentry = HeNEXT(entry);
1570 if (i && !*oentry)
cdff3ec0 1571 HvFILL(hv)--;
ff68c719 1572 Safefree(HeKEY_hek(entry));
d33b2eba 1573 del_HE(entry);
cdff3ec0 1574 HvKEYS(hv)--;
fde52b5c 1575 }
bbce6d69 1576 break;
fde52b5c 1577 }
333f433b 1578 UNLOCK_STRTAB_MUTEX;
f9a63242
JH
1579 if (str != save)
1580 Safefree(str);
411caa50
JH
1581 if (!found && ckWARN_d(WARN_INTERNAL))
1582 Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
fde52b5c
PP
1583}
1584
bbce6d69
PP
1585/* get a (constant) string ptr from the global string table
1586 * string will get added if it is not already there.
fde52b5c
PP
1587 * len and hash must both be valid for str.
1588 */
bbce6d69 1589HEK *
864dbfa3 1590Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
fde52b5c 1591{
cdff3ec0 1592 HV *hv;
fde52b5c
PP
1593 register HE *entry;
1594 register HE **oentry;
1595 register I32 i = 1;
1596 I32 found = 0;
da58a35d 1597 bool is_utf8 = FALSE;
f9a63242 1598 const char *save = str;
da58a35d
JH
1599
1600 if (len < 0) {
1601 len = -len;
1602 is_utf8 = TRUE;
75a54232
JH
1603 if (!(PL_hints & HINT_UTF8_DISTINCT)) {
1604 STRLEN tmplen = len;
1605 /* See the note in hv_fetch(). --jhi */
1606 str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
1607 len = tmplen;
1608 }
da58a35d 1609 }
bbce6d69 1610
fde52b5c 1611 /* what follows is the moral equivalent of:
1c846c1f 1612
6b88bc9c
GS
1613 if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
1614 hv_store(PL_strtab, str, len, Nullsv, hash);
bbce6d69 1615 */
fde52b5c 1616 /* assert(xhv_array != 0) */
cdff3ec0 1617 hv = PL_strtab;
5f08fbcd 1618 LOCK_STRTAB_MUTEX;
cdff3ec0 1619 oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
bbce6d69 1620 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
fde52b5c
PP
1621 if (HeHASH(entry) != hash) /* strings can't be equal */
1622 continue;
1623 if (HeKLEN(entry) != len)
1624 continue;
1c846c1f 1625 if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
fde52b5c 1626 continue;
c3654f1a
IH
1627 if (HeKUTF8(entry) != (char)is_utf8)
1628 continue;
fde52b5c 1629 found = 1;
fde52b5c
PP
1630 break;
1631 }
bbce6d69 1632 if (!found) {
d33b2eba 1633 entry = new_HE();
c3654f1a 1634 HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
bbce6d69
PP
1635 HeVAL(entry) = Nullsv;
1636 HeNEXT(entry) = *oentry;
1637 *oentry = entry;
cdff3ec0 1638 HvKEYS(hv)++;
bbce6d69 1639 if (i) { /* initial entry? */
cdff3ec0
AMS
1640 HvFILL(hv)++;
1641 if (HvKEYS(hv) > HvMAX(hv))
1642 hsplit(hv);
bbce6d69
PP
1643 }
1644 }
1645
1646 ++HeVAL(entry); /* use value slot as REFCNT */
5f08fbcd 1647 UNLOCK_STRTAB_MUTEX;
f9a63242
JH
1648 if (str != save)
1649 Safefree(str);
ff68c719 1650 return HeKEY_hek(entry);
fde52b5c 1651}