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