This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix typo in Thread.xs.
[perl5.git] / hv.c
CommitLineData
a0d0e21e 1/* hv.c
79072805 2 *
9607fc9c 3 * Copyright (c) 1991-1997, 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"
15#include "perl.h"
16
a0d0e21e
LW
17static void hsplit _((HV *hv));
18static void hfreeentries _((HV *hv));
79072805 19
8ac85365 20static HE* more_he(void);
4633a7c4
LW
21
22static HE*
8ac85365 23new_he(void)
4633a7c4
LW
24{
25 HE* he;
26 if (he_root) {
27 he = he_root;
fde52b5c 28 he_root = HeNEXT(he);
4633a7c4
LW
29 return he;
30 }
31 return more_he();
32}
33
34static void
8ac85365 35del_he(HE *p)
4633a7c4 36{
fde52b5c 37 HeNEXT(p) = (HE*)he_root;
4633a7c4
LW
38 he_root = p;
39}
40
41static HE*
8ac85365 42more_he(void)
4633a7c4
LW
43{
44 register HE* he;
45 register HE* heend;
46 he_root = (HE*)safemalloc(1008);
47 he = he_root;
48 heend = &he[1008 / sizeof(HE) - 1];
49 while (he < heend) {
fde52b5c 50 HeNEXT(he) = (HE*)(he + 1);
4633a7c4
LW
51 he++;
52 }
fde52b5c 53 HeNEXT(he) = 0;
4633a7c4
LW
54 return new_he();
55}
56
bbce6d69 57static HEK *
8ac85365 58save_hek(char *str, I32 len, U32 hash)
bbce6d69
PP
59{
60 char *k;
61 register HEK *hek;
62
ff68c719 63 New(54, k, HEK_BASESIZE + len + 1, char);
bbce6d69 64 hek = (HEK*)k;
ff68c719
PP
65 Copy(str, HEK_KEY(hek), len, char);
66 *(HEK_KEY(hek) + len) = '\0';
67 HEK_LEN(hek) = len;
68 HEK_HASH(hek) = hash;
bbce6d69
PP
69 return hek;
70}
71
72void
8ac85365 73unshare_hek(HEK *hek)
bbce6d69 74{
ff68c719 75 unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
bbce6d69
PP
76}
77
fde52b5c
PP
78/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
79 * contains an SV* */
80
79072805 81SV**
8ac85365 82hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
79072805
LW
83{
84 register XPVHV* xhv;
fde52b5c 85 register U32 hash;
79072805 86 register HE *entry;
79072805 87 SV *sv;
79072805
LW
88
89 if (!hv)
90 return 0;
463ee0b2 91
8990e307 92 if (SvRMAGICAL(hv)) {
463ee0b2 93 if (mg_find((SV*)hv,'P')) {
11343788 94 dTHR;
8990e307 95 sv = sv_newmortal();
463ee0b2 96 mg_copy((SV*)hv, sv, key, klen);
463ee0b2
LW
97 Sv = sv;
98 return &Sv;
99 }
100 }
101
79072805
LW
102 xhv = (XPVHV*)SvANY(hv);
103 if (!xhv->xhv_array) {
a0d0e21e
LW
104 if (lval
105#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
106 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
107#endif
108 )
463ee0b2 109 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
79072805
LW
110 else
111 return 0;
112 }
113
fde52b5c 114 PERL_HASH(hash, key, klen);
79072805 115
a0d0e21e 116 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
fde52b5c
PP
117 for (; entry; entry = HeNEXT(entry)) {
118 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 119 continue;
fde52b5c 120 if (HeKLEN(entry) != klen)
79072805 121 continue;
36477c24 122 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 123 continue;
fde52b5c 124 return &HeVAL(entry);
79072805 125 }
a0d0e21e
LW
126#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
127 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
128 char *gotenv;
129
1e422769 130 if ((gotenv = ENV_getenv(key)) != Nullch) {
a0d0e21e 131 sv = newSVpv(gotenv,strlen(gotenv));
1e422769 132 SvTAINTED_on(sv);
a0d0e21e
LW
133 return hv_store(hv,key,klen,sv,hash);
134 }
135 }
136#endif
79072805
LW
137 if (lval) { /* gonna assign to this, so it better be there */
138 sv = NEWSV(61,0);
139 return hv_store(hv,key,klen,sv,hash);
140 }
141 return 0;
142}
143
fde52b5c
PP
144/* returns a HE * structure with the all fields set */
145/* note that hent_val will be a mortal sv for MAGICAL hashes */
146HE *
8ac85365 147hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
fde52b5c
PP
148{
149 register XPVHV* xhv;
150 register char *key;
151 STRLEN klen;
152 register HE *entry;
153 SV *sv;
154
155 if (!hv)
156 return 0;
157
fde52b5c 158 if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
1cf368ac 159 static HE mh;
ff68c719 160
fde52b5c 161 sv = sv_newmortal();
effa1e2d 162 keysv = sv_2mortal(newSVsv(keysv));
fde52b5c 163 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
1cf368ac
CS
164 if (!HeKEY_hek(&mh)) {
165 char *k;
166 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
167 HeKEY_hek(&mh) = (HEK*)k;
1cf368ac
CS
168 }
169 HeSVKEY_set(&mh, keysv);
170 HeVAL(&mh) = sv;
171 return &mh;
fde52b5c
PP
172 }
173
effa1e2d 174 xhv = (XPVHV*)SvANY(hv);
fde52b5c
PP
175 if (!xhv->xhv_array) {
176 if (lval
177#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
178 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
179#endif
180 )
181 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
182 else
183 return 0;
184 }
185
effa1e2d
PP
186 key = SvPV(keysv, klen);
187
188 if (!hash)
189 PERL_HASH(hash, key, klen);
190
fde52b5c
PP
191 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
192 for (; entry; entry = HeNEXT(entry)) {
193 if (HeHASH(entry) != hash) /* strings can't be equal */
194 continue;
195 if (HeKLEN(entry) != klen)
196 continue;
36477c24 197 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
198 continue;
199 return entry;
200 }
201#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
202 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
203 char *gotenv;
204
1e422769 205 if ((gotenv = ENV_getenv(key)) != Nullch) {
fde52b5c 206 sv = newSVpv(gotenv,strlen(gotenv));
1e422769 207 SvTAINTED_on(sv);
fde52b5c
PP
208 return hv_store_ent(hv,keysv,sv,hash);
209 }
210 }
211#endif
212 if (lval) { /* gonna assign to this, so it better be there */
213 sv = NEWSV(61,0);
214 return hv_store_ent(hv,keysv,sv,hash);
215 }
216 return 0;
217}
218
79072805 219SV**
8ac85365 220hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
79072805
LW
221{
222 register XPVHV* xhv;
79072805
LW
223 register I32 i;
224 register HE *entry;
225 register HE **oentry;
79072805
LW
226
227 if (!hv)
228 return 0;
229
230 xhv = (XPVHV*)SvANY(hv);
463ee0b2 231 if (SvMAGICAL(hv)) {
463ee0b2 232 mg_copy((SV*)hv, val, key, klen);
1cf368ac
CS
233 if (!xhv->xhv_array
234 && (SvMAGIC(hv)->mg_moremagic
235 || (SvMAGIC(hv)->mg_type != 'E'
236#ifdef OVERLOAD
237 && SvMAGIC(hv)->mg_type != 'A'
a0d0e21e 238#endif /* OVERLOAD */
1cf368ac
CS
239 )))
240 return 0;
463ee0b2 241 }
fde52b5c
PP
242 if (!hash)
243 PERL_HASH(hash, key, klen);
244
245 if (!xhv->xhv_array)
246 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
247
248 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
249 i = 1;
250
251 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
252 if (HeHASH(entry) != hash) /* strings can't be equal */
253 continue;
254 if (HeKLEN(entry) != klen)
255 continue;
36477c24 256 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
257 continue;
258 SvREFCNT_dec(HeVAL(entry));
259 HeVAL(entry) = val;
260 return &HeVAL(entry);
261 }
262
263 entry = new_he();
fde52b5c 264 if (HvSHAREKEYS(hv))
ff68c719 265 HeKEY_hek(entry) = share_hek(key, klen, hash);
fde52b5c 266 else /* gotta do the real thing */
ff68c719 267 HeKEY_hek(entry) = save_hek(key, klen, hash);
fde52b5c 268 HeVAL(entry) = val;
fde52b5c
PP
269 HeNEXT(entry) = *oentry;
270 *oentry = entry;
271
272 xhv->xhv_keys++;
273 if (i) { /* initial entry? */
274 ++xhv->xhv_fill;
275 if (xhv->xhv_keys > xhv->xhv_max)
276 hsplit(hv);
79072805
LW
277 }
278
fde52b5c
PP
279 return &HeVAL(entry);
280}
281
282HE *
8ac85365 283hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
fde52b5c
PP
284{
285 register XPVHV* xhv;
286 register char *key;
287 STRLEN klen;
288 register I32 i;
289 register HE *entry;
290 register HE **oentry;
291
292 if (!hv)
293 return 0;
294
295 xhv = (XPVHV*)SvANY(hv);
296 if (SvMAGICAL(hv)) {
aeea060c 297 dTHR;
1e422769
PP
298 bool save_taint = tainted;
299 if (tainting)
300 tainted = SvTAINTED(keysv);
effa1e2d 301 keysv = sv_2mortal(newSVsv(keysv));
fde52b5c 302 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
1e422769 303 TAINT_IF(save_taint);
1cf368ac
CS
304 if (!xhv->xhv_array
305 && (SvMAGIC(hv)->mg_moremagic
306 || (SvMAGIC(hv)->mg_type != 'E'
307#ifdef OVERLOAD
308 && SvMAGIC(hv)->mg_type != 'A'
fde52b5c 309#endif /* OVERLOAD */
1cf368ac
CS
310 )))
311 return Nullhe;
fde52b5c
PP
312 }
313
314 key = SvPV(keysv, klen);
315
316 if (!hash)
317 PERL_HASH(hash, key, klen);
318
79072805 319 if (!xhv->xhv_array)
463ee0b2 320 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
79072805 321
a0d0e21e 322 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
323 i = 1;
324
fde52b5c
PP
325 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
326 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 327 continue;
fde52b5c 328 if (HeKLEN(entry) != klen)
79072805 329 continue;
36477c24 330 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 331 continue;
fde52b5c
PP
332 SvREFCNT_dec(HeVAL(entry));
333 HeVAL(entry) = val;
334 return entry;
79072805 335 }
79072805 336
4633a7c4 337 entry = new_he();
fde52b5c 338 if (HvSHAREKEYS(hv))
ff68c719 339 HeKEY_hek(entry) = share_hek(key, klen, hash);
fde52b5c 340 else /* gotta do the real thing */
ff68c719 341 HeKEY_hek(entry) = save_hek(key, klen, hash);
fde52b5c 342 HeVAL(entry) = val;
fde52b5c 343 HeNEXT(entry) = *oentry;
79072805
LW
344 *oentry = entry;
345
463ee0b2 346 xhv->xhv_keys++;
79072805 347 if (i) { /* initial entry? */
463ee0b2
LW
348 ++xhv->xhv_fill;
349 if (xhv->xhv_keys > xhv->xhv_max)
79072805
LW
350 hsplit(hv);
351 }
79072805 352
fde52b5c 353 return entry;
79072805
LW
354}
355
356SV *
8ac85365 357hv_delete(HV *hv, char *key, U32 klen, I32 flags)
79072805
LW
358{
359 register XPVHV* xhv;
79072805 360 register I32 i;
fde52b5c 361 register U32 hash;
79072805
LW
362 register HE *entry;
363 register HE **oentry;
364 SV *sv;
79072805
LW
365
366 if (!hv)
367 return Nullsv;
8990e307 368 if (SvRMAGICAL(hv)) {
463ee0b2
LW
369 sv = *hv_fetch(hv, key, klen, TRUE);
370 mg_clear(sv);
fde52b5c
PP
371 if (mg_find(sv, 's')) {
372 return Nullsv; /* %SIG elements cannot be deleted */
373 }
a0d0e21e
LW
374 if (mg_find(sv, 'p')) {
375 sv_unmagic(sv, 'p'); /* No longer an element */
376 return sv;
377 }
463ee0b2 378 }
79072805
LW
379 xhv = (XPVHV*)SvANY(hv);
380 if (!xhv->xhv_array)
381 return Nullsv;
fde52b5c
PP
382
383 PERL_HASH(hash, key, klen);
79072805 384
a0d0e21e 385 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
386 entry = *oentry;
387 i = 1;
fde52b5c
PP
388 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
389 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 390 continue;
fde52b5c 391 if (HeKLEN(entry) != klen)
79072805 392 continue;
36477c24 393 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 394 continue;
fde52b5c 395 *oentry = HeNEXT(entry);
79072805
LW
396 if (i && !*oentry)
397 xhv->xhv_fill--;
748a9306
LW
398 if (flags & G_DISCARD)
399 sv = Nullsv;
400 else
fde52b5c 401 sv = sv_mortalcopy(HeVAL(entry));
a0d0e21e 402 if (entry == xhv->xhv_eiter)
72940dca 403 HvLAZYDEL_on(hv);
a0d0e21e 404 else
68dc0745 405 hv_free_ent(hv, entry);
fde52b5c
PP
406 --xhv->xhv_keys;
407 return sv;
408 }
409 return Nullsv;
410}
411
412SV *
8ac85365 413hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
fde52b5c
PP
414{
415 register XPVHV* xhv;
416 register I32 i;
417 register char *key;
418 STRLEN klen;
419 register HE *entry;
420 register HE **oentry;
421 SV *sv;
422
423 if (!hv)
424 return Nullsv;
425 if (SvRMAGICAL(hv)) {
426 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
427 sv = HeVAL(entry);
428 mg_clear(sv);
429 if (mg_find(sv, 'p')) {
430 sv_unmagic(sv, 'p'); /* No longer an element */
431 return sv;
432 }
433 }
434 xhv = (XPVHV*)SvANY(hv);
435 if (!xhv->xhv_array)
436 return Nullsv;
437
438 key = SvPV(keysv, klen);
439
440 if (!hash)
441 PERL_HASH(hash, key, klen);
442
443 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
444 entry = *oentry;
445 i = 1;
446 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
447 if (HeHASH(entry) != hash) /* strings can't be equal */
448 continue;
449 if (HeKLEN(entry) != klen)
450 continue;
36477c24 451 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
452 continue;
453 *oentry = HeNEXT(entry);
454 if (i && !*oentry)
455 xhv->xhv_fill--;
456 if (flags & G_DISCARD)
457 sv = Nullsv;
458 else
459 sv = sv_mortalcopy(HeVAL(entry));
460 if (entry == xhv->xhv_eiter)
72940dca 461 HvLAZYDEL_on(hv);
fde52b5c 462 else
68dc0745 463 hv_free_ent(hv, entry);
463ee0b2 464 --xhv->xhv_keys;
79072805
LW
465 return sv;
466 }
79072805 467 return Nullsv;
79072805
LW
468}
469
a0d0e21e 470bool
8ac85365 471hv_exists(HV *hv, char *key, U32 klen)
a0d0e21e
LW
472{
473 register XPVHV* xhv;
fde52b5c 474 register U32 hash;
a0d0e21e
LW
475 register HE *entry;
476 SV *sv;
477
478 if (!hv)
479 return 0;
480
481 if (SvRMAGICAL(hv)) {
482 if (mg_find((SV*)hv,'P')) {
11343788 483 dTHR;
a0d0e21e
LW
484 sv = sv_newmortal();
485 mg_copy((SV*)hv, sv, key, klen);
486 magic_existspack(sv, mg_find(sv, 'p'));
487 return SvTRUE(sv);
488 }
489 }
490
491 xhv = (XPVHV*)SvANY(hv);
492 if (!xhv->xhv_array)
493 return 0;
494
fde52b5c 495 PERL_HASH(hash, key, klen);
a0d0e21e
LW
496
497 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
fde52b5c
PP
498 for (; entry; entry = HeNEXT(entry)) {
499 if (HeHASH(entry) != hash) /* strings can't be equal */
a0d0e21e 500 continue;
fde52b5c 501 if (HeKLEN(entry) != klen)
a0d0e21e 502 continue;
36477c24 503 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
504 continue;
505 return TRUE;
506 }
507 return FALSE;
508}
509
510
511bool
8ac85365 512hv_exists_ent(HV *hv, SV *keysv, U32 hash)
fde52b5c
PP
513{
514 register XPVHV* xhv;
515 register char *key;
516 STRLEN klen;
517 register HE *entry;
518 SV *sv;
519
520 if (!hv)
521 return 0;
522
523 if (SvRMAGICAL(hv)) {
524 if (mg_find((SV*)hv,'P')) {
e858de61 525 dTHR; /* just for SvTRUE */
fde52b5c 526 sv = sv_newmortal();
effa1e2d 527 keysv = sv_2mortal(newSVsv(keysv));
fde52b5c
PP
528 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
529 magic_existspack(sv, mg_find(sv, 'p'));
530 return SvTRUE(sv);
531 }
532 }
533
534 xhv = (XPVHV*)SvANY(hv);
535 if (!xhv->xhv_array)
536 return 0;
537
538 key = SvPV(keysv, klen);
539 if (!hash)
540 PERL_HASH(hash, key, klen);
541
542 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
543 for (; entry; entry = HeNEXT(entry)) {
544 if (HeHASH(entry) != hash) /* strings can't be equal */
545 continue;
546 if (HeKLEN(entry) != klen)
547 continue;
36477c24 548 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
a0d0e21e
LW
549 continue;
550 return TRUE;
551 }
552 return FALSE;
553}
554
79072805 555static void
8ac85365 556hsplit(HV *hv)
79072805
LW
557{
558 register XPVHV* xhv = (XPVHV*)SvANY(hv);
a0d0e21e 559 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
79072805
LW
560 register I32 newsize = oldsize * 2;
561 register I32 i;
562 register HE **a;
563 register HE **b;
564 register HE *entry;
565 register HE **oentry;
c07a80fd 566#ifndef STRANGE_MALLOC
4633a7c4 567 I32 tmp;
c07a80fd 568#endif
79072805 569
463ee0b2 570 a = (HE**)xhv->xhv_array;
79072805 571 nomemok = TRUE;
4633a7c4 572#ifdef STRANGE_MALLOC
79072805 573 Renew(a, newsize, HE*);
4633a7c4
LW
574#else
575 i = newsize * sizeof(HE*);
576#define MALLOC_OVERHEAD 16
577 tmp = MALLOC_OVERHEAD;
578 while (tmp - MALLOC_OVERHEAD < i)
579 tmp += tmp;
580 tmp -= MALLOC_OVERHEAD;
581 tmp /= sizeof(HE*);
582 assert(tmp >= newsize);
583 New(2,a, tmp, HE*);
584 Copy(xhv->xhv_array, a, oldsize, HE*);
fba3b22e
MB
585 if (oldsize >= 64) {
586 offer_nice_chunk(xhv->xhv_array,
587 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
4633a7c4
LW
588 }
589 else
590 Safefree(xhv->xhv_array);
591#endif
592
79072805 593 nomemok = FALSE;
79072805
LW
594 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
595 xhv->xhv_max = --newsize;
463ee0b2 596 xhv->xhv_array = (char*)a;
79072805
LW
597
598 for (i=0; i<oldsize; i++,a++) {
599 if (!*a) /* non-existent */
600 continue;
601 b = a+oldsize;
602 for (oentry = a, entry = *a; entry; entry = *oentry) {
fde52b5c
PP
603 if ((HeHASH(entry) & newsize) != i) {
604 *oentry = HeNEXT(entry);
605 HeNEXT(entry) = *b;
79072805
LW
606 if (!*b)
607 xhv->xhv_fill++;
608 *b = entry;
609 continue;
610 }
611 else
fde52b5c 612 oentry = &HeNEXT(entry);
79072805
LW
613 }
614 if (!*a) /* everything moved */
615 xhv->xhv_fill--;
616 }
617}
618
72940dca 619void
8ac85365 620hv_ksplit(HV *hv, IV newmax)
72940dca
PP
621{
622 register XPVHV* xhv = (XPVHV*)SvANY(hv);
623 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
624 register I32 newsize;
625 register I32 i;
626 register I32 j;
627 register HE **a;
628 register HE *entry;
629 register HE **oentry;
630
631 newsize = (I32) newmax; /* possible truncation here */
632 if (newsize != newmax || newmax <= oldsize)
633 return;
634 while ((newsize & (1 + ~newsize)) != newsize) {
635 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
636 }
637 if (newsize < newmax)
638 newsize *= 2;
639 if (newsize < newmax)
640 return; /* overflow detection */
641
642 a = (HE**)xhv->xhv_array;
643 if (a) {
644 nomemok = TRUE;
645#ifdef STRANGE_MALLOC
646 Renew(a, newsize, HE*);
647#else
648 i = newsize * sizeof(HE*);
649 j = MALLOC_OVERHEAD;
650 while (j - MALLOC_OVERHEAD < i)
651 j += j;
652 j -= MALLOC_OVERHEAD;
653 j /= sizeof(HE*);
654 assert(j >= newsize);
655 New(2, a, j, HE*);
656 Copy(xhv->xhv_array, a, oldsize, HE*);
fba3b22e
MB
657 if (oldsize >= 64) {
658 offer_nice_chunk(xhv->xhv_array,
659 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
72940dca
PP
660 }
661 else
662 Safefree(xhv->xhv_array);
663#endif
664 nomemok = FALSE;
665 Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
666 }
667 else {
668 Newz(0, a, newsize, HE*);
669 }
670 xhv->xhv_max = --newsize;
671 xhv->xhv_array = (char*)a;
672 if (!xhv->xhv_fill) /* skip rest if no entries */
673 return;
674
675 for (i=0; i<oldsize; i++,a++) {
676 if (!*a) /* non-existent */
677 continue;
678 for (oentry = a, entry = *a; entry; entry = *oentry) {
679 if ((j = (HeHASH(entry) & newsize)) != i) {
680 j -= i;
681 *oentry = HeNEXT(entry);
682 if (!(HeNEXT(entry) = a[j]))
683 xhv->xhv_fill++;
684 a[j] = entry;
685 continue;
686 }
687 else
688 oentry = &HeNEXT(entry);
689 }
690 if (!*a) /* everything moved */
691 xhv->xhv_fill--;
692 }
693}
694
79072805 695HV *
8ac85365 696newHV(void)
79072805
LW
697{
698 register HV *hv;
699 register XPVHV* xhv;
700
a0d0e21e
LW
701 hv = (HV*)NEWSV(502,0);
702 sv_upgrade((SV *)hv, SVt_PVHV);
79072805
LW
703 xhv = (XPVHV*)SvANY(hv);
704 SvPOK_off(hv);
705 SvNOK_off(hv);
fde52b5c
PP
706#ifndef NODEFAULT_SHAREKEYS
707 HvSHAREKEYS_on(hv); /* key-sharing on by default */
708#endif
463ee0b2 709 xhv->xhv_max = 7; /* start with 8 buckets */
79072805
LW
710 xhv->xhv_fill = 0;
711 xhv->xhv_pmroot = 0;
79072805
LW
712 (void)hv_iterinit(hv); /* so each() will start off right */
713 return hv;
714}
715
716void
8ac85365 717hv_free_ent(HV *hv, register HE *entry)
79072805 718{
68dc0745 719 if (!entry)
79072805 720 return;
68dc0745 721 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
44a8e56a 722 sub_generation++; /* may be deletion of method from stash */
68dc0745
PP
723 SvREFCNT_dec(HeVAL(entry));
724 if (HeKLEN(entry) == HEf_SVKEY) {
725 SvREFCNT_dec(HeKEY_sv(entry));
726 Safefree(HeKEY_hek(entry));
44a8e56a
PP
727 }
728 else if (HvSHAREKEYS(hv))
68dc0745 729 unshare_hek(HeKEY_hek(entry));
fde52b5c 730 else
68dc0745
PP
731 Safefree(HeKEY_hek(entry));
732 del_he(entry);
79072805
LW
733}
734
735void
8ac85365 736hv_delayfree_ent(HV *hv, register HE *entry)
79072805 737{
68dc0745 738 if (!entry)
79072805 739 return;
68dc0745 740 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
44a8e56a 741 sub_generation++; /* may be deletion of method from stash */
68dc0745
PP
742 sv_2mortal(HeVAL(entry)); /* free between statements */
743 if (HeKLEN(entry) == HEf_SVKEY) {
744 sv_2mortal(HeKEY_sv(entry));
745 Safefree(HeKEY_hek(entry));
44a8e56a
PP
746 }
747 else if (HvSHAREKEYS(hv))
68dc0745 748 unshare_hek(HeKEY_hek(entry));
fde52b5c 749 else
68dc0745
PP
750 Safefree(HeKEY_hek(entry));
751 del_he(entry);
79072805
LW
752}
753
754void
8ac85365 755hv_clear(HV *hv)
79072805
LW
756{
757 register XPVHV* xhv;
758 if (!hv)
759 return;
760 xhv = (XPVHV*)SvANY(hv);
463ee0b2 761 hfreeentries(hv);
79072805 762 xhv->xhv_fill = 0;
a0d0e21e 763 xhv->xhv_keys = 0;
79072805 764 if (xhv->xhv_array)
463ee0b2 765 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
a0d0e21e
LW
766
767 if (SvRMAGICAL(hv))
768 mg_clear((SV*)hv);
79072805
LW
769}
770
771static void
8ac85365 772hfreeentries(HV *hv)
79072805 773{
a0d0e21e 774 register HE **array;
68dc0745
PP
775 register HE *entry;
776 register HE *oentry = Null(HE*);
a0d0e21e
LW
777 I32 riter;
778 I32 max;
79072805
LW
779
780 if (!hv)
781 return;
a0d0e21e 782 if (!HvARRAY(hv))
79072805 783 return;
a0d0e21e
LW
784
785 riter = 0;
786 max = HvMAX(hv);
787 array = HvARRAY(hv);
68dc0745 788 entry = array[0];
a0d0e21e 789 for (;;) {
68dc0745
PP
790 if (entry) {
791 oentry = entry;
792 entry = HeNEXT(entry);
793 hv_free_ent(hv, oentry);
a0d0e21e 794 }
68dc0745 795 if (!entry) {
a0d0e21e
LW
796 if (++riter > max)
797 break;
68dc0745 798 entry = array[riter];
a0d0e21e 799 }
79072805 800 }
a0d0e21e 801 (void)hv_iterinit(hv);
79072805
LW
802}
803
804void
8ac85365 805hv_undef(HV *hv)
79072805
LW
806{
807 register XPVHV* xhv;
808 if (!hv)
809 return;
810 xhv = (XPVHV*)SvANY(hv);
463ee0b2 811 hfreeentries(hv);
79072805 812 Safefree(xhv->xhv_array);
85e6fe83
LW
813 if (HvNAME(hv)) {
814 Safefree(HvNAME(hv));
815 HvNAME(hv) = 0;
816 }
79072805 817 xhv->xhv_array = 0;
aa689395 818 xhv->xhv_max = 7; /* it's a normal hash */
79072805 819 xhv->xhv_fill = 0;
a0d0e21e
LW
820 xhv->xhv_keys = 0;
821
822 if (SvRMAGICAL(hv))
823 mg_clear((SV*)hv);
79072805
LW
824}
825
79072805 826I32
8ac85365 827hv_iterinit(HV *hv)
79072805 828{
aa689395
PP
829 register XPVHV* xhv;
830 HE *entry;
831
832 if (!hv)
833 croak("Bad hash");
834 xhv = (XPVHV*)SvANY(hv);
835 entry = xhv->xhv_eiter;
effa1e2d 836#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
aa689395
PP
837 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
838 prime_env_iter();
effa1e2d 839#endif
72940dca
PP
840 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
841 HvLAZYDEL_off(hv);
68dc0745 842 hv_free_ent(hv, entry);
72940dca 843 }
79072805
LW
844 xhv->xhv_riter = -1;
845 xhv->xhv_eiter = Null(HE*);
fb73857a 846 return xhv->xhv_fill; /* should be xhv->xhv_keys? May change later */
79072805
LW
847}
848
849HE *
8ac85365 850hv_iternext(HV *hv)
79072805
LW
851{
852 register XPVHV* xhv;
853 register HE *entry;
a0d0e21e 854 HE *oldentry;
463ee0b2 855 MAGIC* mg;
79072805
LW
856
857 if (!hv)
aa689395 858 croak("Bad hash");
79072805 859 xhv = (XPVHV*)SvANY(hv);
a0d0e21e 860 oldentry = entry = xhv->xhv_eiter;
463ee0b2 861
8990e307
LW
862 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
863 SV *key = sv_newmortal();
cd1469e6 864 if (entry) {
fde52b5c 865 sv_setsv(key, HeSVKEY_force(entry));
cd1469e6
PP
866 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
867 }
a0d0e21e 868 else {
ff68c719 869 char *k;
bbce6d69 870 HEK *hek;
ff68c719
PP
871
872 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
4633a7c4 873 Zero(entry, 1, HE);
ff68c719
PP
874 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
875 hek = (HEK*)k;
876 HeKEY_hek(entry) = hek;
fde52b5c 877 HeKLEN(entry) = HEf_SVKEY;
a0d0e21e
LW
878 }
879 magic_nextpack((SV*) hv,mg,key);
463ee0b2 880 if (SvOK(key)) {
cd1469e6 881 /* force key to stay around until next time */
bbce6d69
PP
882 HeSVKEY_set(entry, SvREFCNT_inc(key));
883 return entry; /* beware, hent_val is not set */
463ee0b2 884 }
fde52b5c
PP
885 if (HeVAL(entry))
886 SvREFCNT_dec(HeVAL(entry));
ff68c719 887 Safefree(HeKEY_hek(entry));
4633a7c4 888 del_he(entry);
463ee0b2
LW
889 xhv->xhv_eiter = Null(HE*);
890 return Null(HE*);
79072805 891 }
463ee0b2 892
79072805 893 if (!xhv->xhv_array)
4633a7c4 894 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
fde52b5c
PP
895 if (entry)
896 entry = HeNEXT(entry);
897 while (!entry) {
898 ++xhv->xhv_riter;
899 if (xhv->xhv_riter > xhv->xhv_max) {
900 xhv->xhv_riter = -1;
901 break;
79072805 902 }
fde52b5c
PP
903 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
904 }
79072805 905
72940dca
PP
906 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
907 HvLAZYDEL_off(hv);
68dc0745 908 hv_free_ent(hv, oldentry);
72940dca 909 }
a0d0e21e 910
79072805
LW
911 xhv->xhv_eiter = entry;
912 return entry;
913}
914
915char *
8ac85365 916hv_iterkey(register HE *entry, I32 *retlen)
79072805 917{
fde52b5c 918 if (HeKLEN(entry) == HEf_SVKEY) {
fb73857a
PP
919 STRLEN len;
920 char *p = SvPV(HeKEY_sv(entry), len);
921 *retlen = len;
922 return p;
fde52b5c
PP
923 }
924 else {
925 *retlen = HeKLEN(entry);
926 return HeKEY(entry);
927 }
928}
929
930/* unlike hv_iterval(), this always returns a mortal copy of the key */
931SV *
8ac85365 932hv_iterkeysv(register HE *entry)
fde52b5c
PP
933{
934 if (HeKLEN(entry) == HEf_SVKEY)
bbce6d69 935 return sv_mortalcopy(HeKEY_sv(entry));
fde52b5c
PP
936 else
937 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
938 HeKLEN(entry)));
79072805
LW
939}
940
941SV *
8ac85365 942hv_iterval(HV *hv, register HE *entry)
79072805 943{
8990e307 944 if (SvRMAGICAL(hv)) {
463ee0b2 945 if (mg_find((SV*)hv,'P')) {
8990e307 946 SV* sv = sv_newmortal();
bbce6d69
PP
947 if (HeKLEN(entry) == HEf_SVKEY)
948 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
949 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
463ee0b2
LW
950 return sv;
951 }
79072805 952 }
fde52b5c 953 return HeVAL(entry);
79072805
LW
954}
955
a0d0e21e 956SV *
8ac85365 957hv_iternextsv(HV *hv, char **key, I32 *retlen)
a0d0e21e
LW
958{
959 HE *he;
960 if ( (he = hv_iternext(hv)) == NULL)
961 return NULL;
962 *key = hv_iterkey(he, retlen);
963 return hv_iterval(hv, he);
964}
965
79072805 966void
8ac85365 967hv_magic(HV *hv, GV *gv, int how)
79072805 968{
a0d0e21e 969 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
79072805 970}
fde52b5c 971
bbce6d69 972char*
8ac85365 973sharepvn(char *sv, I32 len, U32 hash)
bbce6d69 974{
ff68c719 975 return HEK_KEY(share_hek(sv, len, hash));
bbce6d69
PP
976}
977
978/* possibly free a shared string if no one has access to it
fde52b5c
PP
979 * len and hash must both be valid for str.
980 */
bbce6d69 981void
8ac85365 982unsharepvn(char *str, I32 len, U32 hash)
fde52b5c
PP
983{
984 register XPVHV* xhv;
985 register HE *entry;
986 register HE **oentry;
987 register I32 i = 1;
988 I32 found = 0;
bbce6d69 989
fde52b5c 990 /* what follows is the moral equivalent of:
bbce6d69
PP
991 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
992 if (--*Svp == Nullsv)
993 hv_delete(strtab, str, len, G_DISCARD, hash);
994 } */
fde52b5c
PP
995 xhv = (XPVHV*)SvANY(strtab);
996 /* assert(xhv_array != 0) */
997 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
bbce6d69 998 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
fde52b5c
PP
999 if (HeHASH(entry) != hash) /* strings can't be equal */
1000 continue;
1001 if (HeKLEN(entry) != len)
1002 continue;
36477c24 1003 if (memNE(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
1004 continue;
1005 found = 1;
bbce6d69
PP
1006 if (--HeVAL(entry) == Nullsv) {
1007 *oentry = HeNEXT(entry);
1008 if (i && !*oentry)
1009 xhv->xhv_fill--;
ff68c719 1010 Safefree(HeKEY_hek(entry));
bbce6d69
PP
1011 del_he(entry);
1012 --xhv->xhv_keys;
fde52b5c 1013 }
bbce6d69 1014 break;
fde52b5c 1015 }
bbce6d69
PP
1016
1017 if (!found)
1018 warn("Attempt to free non-existent shared string");
fde52b5c
PP
1019}
1020
bbce6d69
PP
1021/* get a (constant) string ptr from the global string table
1022 * string will get added if it is not already there.
fde52b5c
PP
1023 * len and hash must both be valid for str.
1024 */
bbce6d69 1025HEK *
8ac85365 1026share_hek(char *str, I32 len, register U32 hash)
fde52b5c
PP
1027{
1028 register XPVHV* xhv;
1029 register HE *entry;
1030 register HE **oentry;
1031 register I32 i = 1;
1032 I32 found = 0;
bbce6d69 1033
fde52b5c 1034 /* what follows is the moral equivalent of:
bbce6d69
PP
1035
1036 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1037 hv_store(strtab, str, len, Nullsv, hash);
1038 */
fde52b5c
PP
1039 xhv = (XPVHV*)SvANY(strtab);
1040 /* assert(xhv_array != 0) */
1041 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
bbce6d69 1042 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
fde52b5c
PP
1043 if (HeHASH(entry) != hash) /* strings can't be equal */
1044 continue;
1045 if (HeKLEN(entry) != len)
1046 continue;
36477c24 1047 if (memNE(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
1048 continue;
1049 found = 1;
fde52b5c
PP
1050 break;
1051 }
bbce6d69
PP
1052 if (!found) {
1053 entry = new_he();
ff68c719 1054 HeKEY_hek(entry) = save_hek(str, len, hash);
bbce6d69
PP
1055 HeVAL(entry) = Nullsv;
1056 HeNEXT(entry) = *oentry;
1057 *oentry = entry;
1058 xhv->xhv_keys++;
1059 if (i) { /* initial entry? */
1060 ++xhv->xhv_fill;
1061 if (xhv->xhv_keys > xhv->xhv_max)
1062 hsplit(strtab);
1063 }
1064 }
1065
1066 ++HeVAL(entry); /* use value slot as REFCNT */
ff68c719 1067 return HeKEY_hek(entry);
fde52b5c
PP
1068}
1069
bbce6d69 1070