3 * Copyright (c) 1991-1997, Larry Wall
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.
11 * "I sit beside the fire and think of all that I have seen." --Bilbo
17 static void hsplit _((HV *hv));
18 static void hfreeentries _((HV *hv));
38 HeNEXT(p) = (HE*)he_root;
47 he_root = (HE*)safemalloc(1008);
49 heend = &he[1008 / sizeof(HE) - 1];
51 HeNEXT(he) = (HE*)(he + 1);
59 save_hek(str, len, hash)
67 New(54, k, HEK_BASESIZE + len + 1, char);
69 Copy(str, HEK_KEY(hek), len, char);
70 *(HEK_KEY(hek) + len) = '\0';
80 unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
83 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
87 hv_fetch(hv,key,klen,lval)
101 if (SvRMAGICAL(hv)) {
102 if (mg_find((SV*)hv,'P')) {
105 mg_copy((SV*)hv, sv, key, klen);
111 xhv = (XPVHV*)SvANY(hv);
112 if (!xhv->xhv_array) {
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))
118 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
123 PERL_HASH(hash, key, klen);
125 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
126 for (; entry; entry = HeNEXT(entry)) {
127 if (HeHASH(entry) != hash) /* strings can't be equal */
129 if (HeKLEN(entry) != klen)
131 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
133 return &HeVAL(entry);
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)) {
139 if ((gotenv = ENV_getenv(key)) != Nullch) {
140 sv = newSVpv(gotenv,strlen(gotenv));
142 return hv_store(hv,key,klen,sv,hash);
146 if (lval) { /* gonna assign to this, so it better be there */
148 return hv_store(hv,key,klen,sv,hash);
153 /* returns a HE * structure with the all fields set */
154 /* note that hent_val will be a mortal sv for MAGICAL hashes */
156 hv_fetch_ent(hv,keysv,lval,hash)
171 if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
175 keysv = sv_2mortal(newSVsv(keysv));
176 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
177 if (!HeKEY_hek(&mh)) {
179 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
180 HeKEY_hek(&mh) = (HEK*)k;
182 HeSVKEY_set(&mh, keysv);
187 xhv = (XPVHV*)SvANY(hv);
188 if (!xhv->xhv_array) {
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))
194 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
199 key = SvPV(keysv, klen);
202 PERL_HASH(hash, key, klen);
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 */
208 if (HeKLEN(entry) != klen)
210 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
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)) {
218 if ((gotenv = ENV_getenv(key)) != Nullch) {
219 sv = newSVpv(gotenv,strlen(gotenv));
221 return hv_store_ent(hv,keysv,sv,hash);
225 if (lval) { /* gonna assign to this, so it better be there */
227 return hv_store_ent(hv,keysv,sv,hash);
233 hv_store(hv,key,klen,val,hash)
243 register HE **oentry;
248 xhv = (XPVHV*)SvANY(hv);
250 mg_copy((SV*)hv, val, key, klen);
252 && (SvMAGIC(hv)->mg_moremagic
253 || (SvMAGIC(hv)->mg_type != 'E'
255 && SvMAGIC(hv)->mg_type != 'A'
256 #endif /* OVERLOAD */
261 PERL_HASH(hash, key, klen);
264 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
266 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
269 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
270 if (HeHASH(entry) != hash) /* strings can't be equal */
272 if (HeKLEN(entry) != klen)
274 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
276 SvREFCNT_dec(HeVAL(entry));
278 return &HeVAL(entry);
283 HeKEY_hek(entry) = share_hek(key, klen, hash);
284 else /* gotta do the real thing */
285 HeKEY_hek(entry) = save_hek(key, klen, hash);
287 HeNEXT(entry) = *oentry;
291 if (i) { /* initial entry? */
293 if (xhv->xhv_keys > xhv->xhv_max)
297 return &HeVAL(entry);
301 hv_store_ent(hv,keysv,val,hash)
312 register HE **oentry;
317 xhv = (XPVHV*)SvANY(hv);
320 bool save_taint = tainted;
322 tainted = SvTAINTED(keysv);
323 keysv = sv_2mortal(newSVsv(keysv));
324 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
325 TAINT_IF(save_taint);
327 && (SvMAGIC(hv)->mg_moremagic
328 || (SvMAGIC(hv)->mg_type != 'E'
330 && SvMAGIC(hv)->mg_type != 'A'
331 #endif /* OVERLOAD */
336 key = SvPV(keysv, klen);
339 PERL_HASH(hash, key, klen);
342 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
344 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
347 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
348 if (HeHASH(entry) != hash) /* strings can't be equal */
350 if (HeKLEN(entry) != klen)
352 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
354 SvREFCNT_dec(HeVAL(entry));
361 HeKEY_hek(entry) = share_hek(key, klen, hash);
362 else /* gotta do the real thing */
363 HeKEY_hek(entry) = save_hek(key, klen, hash);
365 HeNEXT(entry) = *oentry;
369 if (i) { /* initial entry? */
371 if (xhv->xhv_keys > xhv->xhv_max)
379 hv_delete(hv,key,klen,flags)
389 register HE **oentry;
394 if (SvRMAGICAL(hv)) {
395 sv = *hv_fetch(hv, key, klen, TRUE);
397 if (mg_find(sv, 's')) {
398 return Nullsv; /* %SIG elements cannot be deleted */
400 if (mg_find(sv, 'p')) {
401 sv_unmagic(sv, 'p'); /* No longer an element */
405 xhv = (XPVHV*)SvANY(hv);
409 PERL_HASH(hash, key, klen);
411 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
414 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
415 if (HeHASH(entry) != hash) /* strings can't be equal */
417 if (HeKLEN(entry) != klen)
419 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
421 *oentry = HeNEXT(entry);
424 if (flags & G_DISCARD)
427 sv = sv_mortalcopy(HeVAL(entry));
428 if (entry == xhv->xhv_eiter)
431 hv_free_ent(hv, entry);
439 hv_delete_ent(hv,keysv,flags,hash)
450 register HE **oentry;
455 if (SvRMAGICAL(hv)) {
456 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
459 if (mg_find(sv, 'p')) {
460 sv_unmagic(sv, 'p'); /* No longer an element */
464 xhv = (XPVHV*)SvANY(hv);
468 key = SvPV(keysv, klen);
471 PERL_HASH(hash, key, klen);
473 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
476 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
477 if (HeHASH(entry) != hash) /* strings can't be equal */
479 if (HeKLEN(entry) != klen)
481 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
483 *oentry = HeNEXT(entry);
486 if (flags & G_DISCARD)
489 sv = sv_mortalcopy(HeVAL(entry));
490 if (entry == xhv->xhv_eiter)
493 hv_free_ent(hv, entry);
501 hv_exists(hv,key,klen)
514 if (SvRMAGICAL(hv)) {
515 if (mg_find((SV*)hv,'P')) {
518 mg_copy((SV*)hv, sv, key, klen);
519 magic_existspack(sv, mg_find(sv, 'p'));
524 xhv = (XPVHV*)SvANY(hv);
528 PERL_HASH(hash, key, klen);
530 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
531 for (; entry; entry = HeNEXT(entry)) {
532 if (HeHASH(entry) != hash) /* strings can't be equal */
534 if (HeKLEN(entry) != klen)
536 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
545 hv_exists_ent(hv,keysv,hash)
559 if (SvRMAGICAL(hv)) {
560 if (mg_find((SV*)hv,'P')) {
561 dTHR; /* just for SvTRUE */
563 keysv = sv_2mortal(newSVsv(keysv));
564 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
565 magic_existspack(sv, mg_find(sv, 'p'));
570 xhv = (XPVHV*)SvANY(hv);
574 key = SvPV(keysv, klen);
576 PERL_HASH(hash, key, klen);
578 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
579 for (; entry; entry = HeNEXT(entry)) {
580 if (HeHASH(entry) != hash) /* strings can't be equal */
582 if (HeKLEN(entry) != klen)
584 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
595 register XPVHV* xhv = (XPVHV*)SvANY(hv);
596 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
597 register I32 newsize = oldsize * 2;
602 register HE **oentry;
603 #ifndef STRANGE_MALLOC
607 a = (HE**)xhv->xhv_array;
609 #ifdef STRANGE_MALLOC
610 Renew(a, newsize, HE*);
612 i = newsize * sizeof(HE*);
613 #define MALLOC_OVERHEAD 16
614 tmp = MALLOC_OVERHEAD;
615 while (tmp - MALLOC_OVERHEAD < i)
617 tmp -= MALLOC_OVERHEAD;
619 assert(tmp >= newsize);
621 Copy(xhv->xhv_array, a, oldsize, HE*);
623 offer_nice_chunk(xhv->xhv_array,
624 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
627 Safefree(xhv->xhv_array);
631 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
632 xhv->xhv_max = --newsize;
633 xhv->xhv_array = (char*)a;
635 for (i=0; i<oldsize; i++,a++) {
636 if (!*a) /* non-existent */
639 for (oentry = a, entry = *a; entry; entry = *oentry) {
640 if ((HeHASH(entry) & newsize) != i) {
641 *oentry = HeNEXT(entry);
649 oentry = &HeNEXT(entry);
651 if (!*a) /* everything moved */
657 hv_ksplit(hv, newmax)
661 register XPVHV* xhv = (XPVHV*)SvANY(hv);
662 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
663 register I32 newsize;
668 register HE **oentry;
670 newsize = (I32) newmax; /* possible truncation here */
671 if (newsize != newmax || newmax <= oldsize)
673 while ((newsize & (1 + ~newsize)) != newsize) {
674 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
676 if (newsize < newmax)
678 if (newsize < newmax)
679 return; /* overflow detection */
681 a = (HE**)xhv->xhv_array;
684 #ifdef STRANGE_MALLOC
685 Renew(a, newsize, HE*);
687 i = newsize * sizeof(HE*);
689 while (j - MALLOC_OVERHEAD < i)
691 j -= MALLOC_OVERHEAD;
693 assert(j >= newsize);
695 Copy(xhv->xhv_array, a, oldsize, HE*);
697 offer_nice_chunk(xhv->xhv_array,
698 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
701 Safefree(xhv->xhv_array);
704 Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
707 Newz(0, a, newsize, HE*);
709 xhv->xhv_max = --newsize;
710 xhv->xhv_array = (char*)a;
711 if (!xhv->xhv_fill) /* skip rest if no entries */
714 for (i=0; i<oldsize; i++,a++) {
715 if (!*a) /* non-existent */
717 for (oentry = a, entry = *a; entry; entry = *oentry) {
718 if ((j = (HeHASH(entry) & newsize)) != i) {
720 *oentry = HeNEXT(entry);
721 if (!(HeNEXT(entry) = a[j]))
727 oentry = &HeNEXT(entry);
729 if (!*a) /* everything moved */
740 hv = (HV*)NEWSV(502,0);
741 sv_upgrade((SV *)hv, SVt_PVHV);
742 xhv = (XPVHV*)SvANY(hv);
745 #ifndef NODEFAULT_SHAREKEYS
746 HvSHAREKEYS_on(hv); /* key-sharing on by default */
748 xhv->xhv_max = 7; /* start with 8 buckets */
751 (void)hv_iterinit(hv); /* so each() will start off right */
756 hv_free_ent(hv, entry)
762 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
763 sub_generation++; /* may be deletion of method from stash */
764 SvREFCNT_dec(HeVAL(entry));
765 if (HeKLEN(entry) == HEf_SVKEY) {
766 SvREFCNT_dec(HeKEY_sv(entry));
767 Safefree(HeKEY_hek(entry));
769 else if (HvSHAREKEYS(hv))
770 unshare_hek(HeKEY_hek(entry));
772 Safefree(HeKEY_hek(entry));
777 hv_delayfree_ent(hv, entry)
783 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
784 sub_generation++; /* may be deletion of method from stash */
785 sv_2mortal(HeVAL(entry)); /* free between statements */
786 if (HeKLEN(entry) == HEf_SVKEY) {
787 sv_2mortal(HeKEY_sv(entry));
788 Safefree(HeKEY_hek(entry));
790 else if (HvSHAREKEYS(hv))
791 unshare_hek(HeKEY_hek(entry));
793 Safefree(HeKEY_hek(entry));
804 xhv = (XPVHV*)SvANY(hv);
809 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
821 register HE *oentry = Null(HE*);
837 entry = HeNEXT(entry);
838 hv_free_ent(hv, oentry);
843 entry = array[riter];
846 (void)hv_iterinit(hv);
856 xhv = (XPVHV*)SvANY(hv);
858 Safefree(xhv->xhv_array);
860 Safefree(HvNAME(hv));
864 xhv->xhv_max = 7; /* it's a normal hash */
881 xhv = (XPVHV*)SvANY(hv);
882 entry = xhv->xhv_eiter;
883 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
884 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
887 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
889 hv_free_ent(hv, entry);
892 xhv->xhv_eiter = Null(HE*);
893 return xhv->xhv_fill; /* should be xhv->xhv_keys? May change later */
907 xhv = (XPVHV*)SvANY(hv);
908 oldentry = entry = xhv->xhv_eiter;
910 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
911 SV *key = sv_newmortal();
913 sv_setsv(key, HeSVKEY_force(entry));
914 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
920 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
922 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
924 HeKEY_hek(entry) = hek;
925 HeKLEN(entry) = HEf_SVKEY;
927 magic_nextpack((SV*) hv,mg,key);
929 /* force key to stay around until next time */
930 HeSVKEY_set(entry, SvREFCNT_inc(key));
931 return entry; /* beware, hent_val is not set */
934 SvREFCNT_dec(HeVAL(entry));
935 Safefree(HeKEY_hek(entry));
937 xhv->xhv_eiter = Null(HE*);
942 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
944 entry = HeNEXT(entry);
947 if (xhv->xhv_riter > xhv->xhv_max) {
951 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
954 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
956 hv_free_ent(hv, oldentry);
959 xhv->xhv_eiter = entry;
964 hv_iterkey(entry,retlen)
968 if (HeKLEN(entry) == HEf_SVKEY) {
970 char *p = SvPV(HeKEY_sv(entry), len);
975 *retlen = HeKLEN(entry);
980 /* unlike hv_iterval(), this always returns a mortal copy of the key */
985 if (HeKLEN(entry) == HEf_SVKEY)
986 return sv_mortalcopy(HeKEY_sv(entry));
988 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
997 if (SvRMAGICAL(hv)) {
998 if (mg_find((SV*)hv,'P')) {
999 SV* sv = sv_newmortal();
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));
1006 return HeVAL(entry);
1010 hv_iternextsv(hv, key, retlen)
1016 if ( (he = hv_iternext(hv)) == NULL)
1018 *key = hv_iterkey(he, retlen);
1019 return hv_iterval(hv, he);
1023 hv_magic(hv, gv, how)
1028 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1032 sharepvn(sv, len, hash)
1037 return HEK_KEY(share_hek(sv, len, hash));
1040 /* possibly free a shared string if no one has access to it
1041 * len and hash must both be valid for str.
1044 unsharepvn(str, len, hash)
1049 register XPVHV* xhv;
1051 register HE **oentry;
1055 /* what follows is the moral equivalent of:
1056 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1057 if (--*Svp == Nullsv)
1058 hv_delete(strtab, str, len, G_DISCARD, hash);
1060 xhv = (XPVHV*)SvANY(strtab);
1061 /* assert(xhv_array != 0) */
1062 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1063 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1064 if (HeHASH(entry) != hash) /* strings can't be equal */
1066 if (HeKLEN(entry) != len)
1068 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1071 if (--HeVAL(entry) == Nullsv) {
1072 *oentry = HeNEXT(entry);
1075 Safefree(HeKEY_hek(entry));
1083 warn("Attempt to free non-existent shared string");
1086 /* get a (constant) string ptr from the global string table
1087 * string will get added if it is not already there.
1088 * len and hash must both be valid for str.
1091 share_hek(str, len, hash)
1096 register XPVHV* xhv;
1098 register HE **oentry;
1102 /* what follows is the moral equivalent of:
1104 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1105 hv_store(strtab, str, len, Nullsv, hash);
1107 xhv = (XPVHV*)SvANY(strtab);
1108 /* assert(xhv_array != 0) */
1109 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1110 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1111 if (HeHASH(entry) != hash) /* strings can't be equal */
1113 if (HeKLEN(entry) != len)
1115 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1122 HeKEY_hek(entry) = save_hek(str, len, hash);
1123 HeVAL(entry) = Nullsv;
1124 HeNEXT(entry) = *oentry;
1127 if (i) { /* initial entry? */
1129 if (xhv->xhv_keys > xhv->xhv_max)
1134 ++HeVAL(entry); /* use value slot as REFCNT */
1135 return HeKEY_hek(entry);