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);
319 bool save_taint = tainted;
321 tainted = SvTAINTED(keysv);
322 keysv = sv_2mortal(newSVsv(keysv));
323 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
324 TAINT_IF(save_taint);
326 && (SvMAGIC(hv)->mg_moremagic
327 || (SvMAGIC(hv)->mg_type != 'E'
329 && SvMAGIC(hv)->mg_type != 'A'
330 #endif /* OVERLOAD */
335 key = SvPV(keysv, klen);
338 PERL_HASH(hash, key, klen);
341 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
343 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
346 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
347 if (HeHASH(entry) != hash) /* strings can't be equal */
349 if (HeKLEN(entry) != klen)
351 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
353 SvREFCNT_dec(HeVAL(entry));
360 HeKEY_hek(entry) = share_hek(key, klen, hash);
361 else /* gotta do the real thing */
362 HeKEY_hek(entry) = save_hek(key, klen, hash);
364 HeNEXT(entry) = *oentry;
368 if (i) { /* initial entry? */
370 if (xhv->xhv_keys > xhv->xhv_max)
378 hv_delete(hv,key,klen,flags)
388 register HE **oentry;
393 if (SvRMAGICAL(hv)) {
394 sv = *hv_fetch(hv, key, klen, TRUE);
396 if (mg_find(sv, 's')) {
397 return Nullsv; /* %SIG elements cannot be deleted */
399 if (mg_find(sv, 'p')) {
400 sv_unmagic(sv, 'p'); /* No longer an element */
404 xhv = (XPVHV*)SvANY(hv);
408 PERL_HASH(hash, key, klen);
410 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
413 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
414 if (HeHASH(entry) != hash) /* strings can't be equal */
416 if (HeKLEN(entry) != klen)
418 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
420 *oentry = HeNEXT(entry);
423 if (flags & G_DISCARD)
426 sv = sv_mortalcopy(HeVAL(entry));
427 if (entry == xhv->xhv_eiter)
430 hv_free_ent(hv, entry);
438 hv_delete_ent(hv,keysv,flags,hash)
449 register HE **oentry;
454 if (SvRMAGICAL(hv)) {
455 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
458 if (mg_find(sv, 'p')) {
459 sv_unmagic(sv, 'p'); /* No longer an element */
463 xhv = (XPVHV*)SvANY(hv);
467 key = SvPV(keysv, klen);
470 PERL_HASH(hash, key, klen);
472 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
475 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
476 if (HeHASH(entry) != hash) /* strings can't be equal */
478 if (HeKLEN(entry) != klen)
480 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
482 *oentry = HeNEXT(entry);
485 if (flags & G_DISCARD)
488 sv = sv_mortalcopy(HeVAL(entry));
489 if (entry == xhv->xhv_eiter)
492 hv_free_ent(hv, entry);
500 hv_exists(hv,key,klen)
513 if (SvRMAGICAL(hv)) {
514 if (mg_find((SV*)hv,'P')) {
517 mg_copy((SV*)hv, sv, key, klen);
518 magic_existspack(sv, mg_find(sv, 'p'));
523 xhv = (XPVHV*)SvANY(hv);
527 PERL_HASH(hash, key, klen);
529 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
530 for (; entry; entry = HeNEXT(entry)) {
531 if (HeHASH(entry) != hash) /* strings can't be equal */
533 if (HeKLEN(entry) != klen)
535 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
544 hv_exists_ent(hv,keysv,hash)
558 if (SvRMAGICAL(hv)) {
559 if (mg_find((SV*)hv,'P')) {
560 dTHR; /* just for SvTRUE */
562 keysv = sv_2mortal(newSVsv(keysv));
563 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
564 magic_existspack(sv, mg_find(sv, 'p'));
569 xhv = (XPVHV*)SvANY(hv);
573 key = SvPV(keysv, klen);
575 PERL_HASH(hash, key, klen);
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 */
581 if (HeKLEN(entry) != klen)
583 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
594 register XPVHV* xhv = (XPVHV*)SvANY(hv);
595 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
596 register I32 newsize = oldsize * 2;
601 register HE **oentry;
602 #ifndef STRANGE_MALLOC
606 a = (HE**)xhv->xhv_array;
608 #ifdef STRANGE_MALLOC
609 Renew(a, newsize, HE*);
611 i = newsize * sizeof(HE*);
612 #define MALLOC_OVERHEAD 16
613 tmp = MALLOC_OVERHEAD;
614 while (tmp - MALLOC_OVERHEAD < i)
616 tmp -= MALLOC_OVERHEAD;
618 assert(tmp >= newsize);
620 Copy(xhv->xhv_array, a, oldsize, HE*);
622 offer_nice_chunk(xhv->xhv_array,
623 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
626 Safefree(xhv->xhv_array);
630 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
631 xhv->xhv_max = --newsize;
632 xhv->xhv_array = (char*)a;
634 for (i=0; i<oldsize; i++,a++) {
635 if (!*a) /* non-existent */
638 for (oentry = a, entry = *a; entry; entry = *oentry) {
639 if ((HeHASH(entry) & newsize) != i) {
640 *oentry = HeNEXT(entry);
648 oentry = &HeNEXT(entry);
650 if (!*a) /* everything moved */
656 hv_ksplit(hv, newmax)
660 register XPVHV* xhv = (XPVHV*)SvANY(hv);
661 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
662 register I32 newsize;
667 register HE **oentry;
669 newsize = (I32) newmax; /* possible truncation here */
670 if (newsize != newmax || newmax <= oldsize)
672 while ((newsize & (1 + ~newsize)) != newsize) {
673 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
675 if (newsize < newmax)
677 if (newsize < newmax)
678 return; /* overflow detection */
680 a = (HE**)xhv->xhv_array;
683 #ifdef STRANGE_MALLOC
684 Renew(a, newsize, HE*);
686 i = newsize * sizeof(HE*);
688 while (j - MALLOC_OVERHEAD < i)
690 j -= MALLOC_OVERHEAD;
692 assert(j >= newsize);
694 Copy(xhv->xhv_array, a, oldsize, HE*);
696 offer_nice_chunk(xhv->xhv_array,
697 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
700 Safefree(xhv->xhv_array);
703 Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
706 Newz(0, a, newsize, HE*);
708 xhv->xhv_max = --newsize;
709 xhv->xhv_array = (char*)a;
710 if (!xhv->xhv_fill) /* skip rest if no entries */
713 for (i=0; i<oldsize; i++,a++) {
714 if (!*a) /* non-existent */
716 for (oentry = a, entry = *a; entry; entry = *oentry) {
717 if ((j = (HeHASH(entry) & newsize)) != i) {
719 *oentry = HeNEXT(entry);
720 if (!(HeNEXT(entry) = a[j]))
726 oentry = &HeNEXT(entry);
728 if (!*a) /* everything moved */
739 hv = (HV*)NEWSV(502,0);
740 sv_upgrade((SV *)hv, SVt_PVHV);
741 xhv = (XPVHV*)SvANY(hv);
744 #ifndef NODEFAULT_SHAREKEYS
745 HvSHAREKEYS_on(hv); /* key-sharing on by default */
747 xhv->xhv_max = 7; /* start with 8 buckets */
750 (void)hv_iterinit(hv); /* so each() will start off right */
755 hv_free_ent(hv, entry)
761 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
762 sub_generation++; /* may be deletion of method from stash */
763 SvREFCNT_dec(HeVAL(entry));
764 if (HeKLEN(entry) == HEf_SVKEY) {
765 SvREFCNT_dec(HeKEY_sv(entry));
766 Safefree(HeKEY_hek(entry));
768 else if (HvSHAREKEYS(hv))
769 unshare_hek(HeKEY_hek(entry));
771 Safefree(HeKEY_hek(entry));
776 hv_delayfree_ent(hv, entry)
782 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
783 sub_generation++; /* may be deletion of method from stash */
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));
789 else if (HvSHAREKEYS(hv))
790 unshare_hek(HeKEY_hek(entry));
792 Safefree(HeKEY_hek(entry));
803 xhv = (XPVHV*)SvANY(hv);
808 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
820 register HE *oentry = Null(HE*);
836 entry = HeNEXT(entry);
837 hv_free_ent(hv, oentry);
842 entry = array[riter];
845 (void)hv_iterinit(hv);
855 xhv = (XPVHV*)SvANY(hv);
857 Safefree(xhv->xhv_array);
859 Safefree(HvNAME(hv));
863 xhv->xhv_max = 7; /* it's a normal hash */
880 xhv = (XPVHV*)SvANY(hv);
881 entry = xhv->xhv_eiter;
882 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
883 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
886 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
888 hv_free_ent(hv, entry);
891 xhv->xhv_eiter = Null(HE*);
892 return xhv->xhv_fill;
906 xhv = (XPVHV*)SvANY(hv);
907 oldentry = entry = xhv->xhv_eiter;
909 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
910 SV *key = sv_newmortal();
912 sv_setsv(key, HeSVKEY_force(entry));
913 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
919 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
921 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
923 HeKEY_hek(entry) = hek;
924 HeKLEN(entry) = HEf_SVKEY;
926 magic_nextpack((SV*) hv,mg,key);
928 dTHR; /* just for SvREFCNT_inc */
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) {
969 return SvPV(HeKEY_sv(entry), *(STRLEN*)retlen);
972 *retlen = HeKLEN(entry);
977 /* unlike hv_iterval(), this always returns a mortal copy of the key */
982 if (HeKLEN(entry) == HEf_SVKEY)
983 return sv_mortalcopy(HeKEY_sv(entry));
985 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
994 if (SvRMAGICAL(hv)) {
995 if (mg_find((SV*)hv,'P')) {
996 SV* sv = sv_newmortal();
997 if (HeKLEN(entry) == HEf_SVKEY)
998 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
999 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1003 return HeVAL(entry);
1007 hv_iternextsv(hv, key, retlen)
1013 if ( (he = hv_iternext(hv)) == NULL)
1015 *key = hv_iterkey(he, retlen);
1016 return hv_iterval(hv, he);
1020 hv_magic(hv, gv, how)
1025 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1029 sharepvn(sv, len, hash)
1034 return HEK_KEY(share_hek(sv, len, hash));
1037 /* possibly free a shared string if no one has access to it
1038 * len and hash must both be valid for str.
1041 unsharepvn(str, len, hash)
1046 register XPVHV* xhv;
1048 register HE **oentry;
1052 /* what follows is the moral equivalent of:
1053 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1054 if (--*Svp == Nullsv)
1055 hv_delete(strtab, str, len, G_DISCARD, hash);
1057 xhv = (XPVHV*)SvANY(strtab);
1058 /* assert(xhv_array != 0) */
1059 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1060 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1061 if (HeHASH(entry) != hash) /* strings can't be equal */
1063 if (HeKLEN(entry) != len)
1065 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1068 if (--HeVAL(entry) == Nullsv) {
1069 *oentry = HeNEXT(entry);
1072 Safefree(HeKEY_hek(entry));
1080 warn("Attempt to free non-existent shared string");
1083 /* get a (constant) string ptr from the global string table
1084 * string will get added if it is not already there.
1085 * len and hash must both be valid for str.
1088 share_hek(str, len, hash)
1093 register XPVHV* xhv;
1095 register HE **oentry;
1099 /* what follows is the moral equivalent of:
1101 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1102 hv_store(strtab, str, len, Nullsv, hash);
1104 xhv = (XPVHV*)SvANY(strtab);
1105 /* assert(xhv_array != 0) */
1106 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1107 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1108 if (HeHASH(entry) != hash) /* strings can't be equal */
1110 if (HeKLEN(entry) != len)
1112 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1119 HeKEY_hek(entry) = save_hek(str, len, hash);
1120 HeVAL(entry) = Nullsv;
1121 HeNEXT(entry) = *oentry;
1124 if (i) { /* initial entry? */
1126 if (xhv->xhv_keys > xhv->xhv_max)
1131 ++HeVAL(entry); /* use value slot as REFCNT */
1132 return HeKEY_hek(entry);