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));
20 static HE* more_he(void);
37 HeNEXT(p) = (HE*)he_root;
46 he_root = (HE*)safemalloc(1008);
48 heend = &he[1008 / sizeof(HE) - 1];
50 HeNEXT(he) = (HE*)(he + 1);
58 save_hek(char *str, I32 len, U32 hash)
63 New(54, k, HEK_BASESIZE + len + 1, char);
65 Copy(str, HEK_KEY(hek), len, char);
66 *(HEK_KEY(hek) + len) = '\0';
75 unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
78 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
82 hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
93 if (mg_find((SV*)hv,'P')) {
96 mg_copy((SV*)hv, sv, key, klen);
102 xhv = (XPVHV*)SvANY(hv);
103 if (!xhv->xhv_array) {
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))
109 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
114 PERL_HASH(hash, key, klen);
116 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
117 for (; entry; entry = HeNEXT(entry)) {
118 if (HeHASH(entry) != hash) /* strings can't be equal */
120 if (HeKLEN(entry) != klen)
122 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
124 return &HeVAL(entry);
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)) {
130 if ((gotenv = ENV_getenv(key)) != Nullch) {
131 sv = newSVpv(gotenv,strlen(gotenv));
133 return hv_store(hv,key,klen,sv,hash);
137 if (lval) { /* gonna assign to this, so it better be there */
139 return hv_store(hv,key,klen,sv,hash);
144 /* returns a HE * structure with the all fields set */
145 /* note that hent_val will be a mortal sv for MAGICAL hashes */
147 hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
158 if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
162 keysv = sv_2mortal(newSVsv(keysv));
163 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
164 if (!HeKEY_hek(&mh)) {
166 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
167 HeKEY_hek(&mh) = (HEK*)k;
169 HeSVKEY_set(&mh, keysv);
174 xhv = (XPVHV*)SvANY(hv);
175 if (!xhv->xhv_array) {
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))
181 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
186 key = SvPV(keysv, klen);
189 PERL_HASH(hash, key, klen);
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 */
195 if (HeKLEN(entry) != klen)
197 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
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)) {
205 if ((gotenv = ENV_getenv(key)) != Nullch) {
206 sv = newSVpv(gotenv,strlen(gotenv));
208 return hv_store_ent(hv,keysv,sv,hash);
212 if (lval) { /* gonna assign to this, so it better be there */
214 return hv_store_ent(hv,keysv,sv,hash);
220 hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
225 register HE **oentry;
230 xhv = (XPVHV*)SvANY(hv);
232 mg_copy((SV*)hv, val, key, klen);
234 && (SvMAGIC(hv)->mg_moremagic
235 || (SvMAGIC(hv)->mg_type != 'E'
237 && SvMAGIC(hv)->mg_type != 'A'
238 #endif /* OVERLOAD */
243 PERL_HASH(hash, key, klen);
246 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
248 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
251 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
252 if (HeHASH(entry) != hash) /* strings can't be equal */
254 if (HeKLEN(entry) != klen)
256 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
258 SvREFCNT_dec(HeVAL(entry));
260 return &HeVAL(entry);
265 HeKEY_hek(entry) = share_hek(key, klen, hash);
266 else /* gotta do the real thing */
267 HeKEY_hek(entry) = save_hek(key, klen, hash);
269 HeNEXT(entry) = *oentry;
273 if (i) { /* initial entry? */
275 if (xhv->xhv_keys > xhv->xhv_max)
279 return &HeVAL(entry);
283 hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
290 register HE **oentry;
295 xhv = (XPVHV*)SvANY(hv);
298 bool save_taint = tainted;
300 tainted = SvTAINTED(keysv);
301 keysv = sv_2mortal(newSVsv(keysv));
302 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
303 TAINT_IF(save_taint);
305 && (SvMAGIC(hv)->mg_moremagic
306 || (SvMAGIC(hv)->mg_type != 'E'
308 && SvMAGIC(hv)->mg_type != 'A'
309 #endif /* OVERLOAD */
314 key = SvPV(keysv, klen);
317 PERL_HASH(hash, key, klen);
320 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
322 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
325 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
326 if (HeHASH(entry) != hash) /* strings can't be equal */
328 if (HeKLEN(entry) != klen)
330 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
332 SvREFCNT_dec(HeVAL(entry));
339 HeKEY_hek(entry) = share_hek(key, klen, hash);
340 else /* gotta do the real thing */
341 HeKEY_hek(entry) = save_hek(key, klen, hash);
343 HeNEXT(entry) = *oentry;
347 if (i) { /* initial entry? */
349 if (xhv->xhv_keys > xhv->xhv_max)
357 hv_delete(HV *hv, char *key, U32 klen, I32 flags)
363 register HE **oentry;
368 if (SvRMAGICAL(hv)) {
369 sv = *hv_fetch(hv, key, klen, TRUE);
371 if (mg_find(sv, 's')) {
372 return Nullsv; /* %SIG elements cannot be deleted */
374 if (mg_find(sv, 'p')) {
375 sv_unmagic(sv, 'p'); /* No longer an element */
379 xhv = (XPVHV*)SvANY(hv);
383 PERL_HASH(hash, key, klen);
385 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
388 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
389 if (HeHASH(entry) != hash) /* strings can't be equal */
391 if (HeKLEN(entry) != klen)
393 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
395 *oentry = HeNEXT(entry);
398 if (flags & G_DISCARD)
401 sv = sv_mortalcopy(HeVAL(entry));
402 if (entry == xhv->xhv_eiter)
405 hv_free_ent(hv, entry);
413 hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
420 register HE **oentry;
425 if (SvRMAGICAL(hv)) {
426 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
429 if (mg_find(sv, 'p')) {
430 sv_unmagic(sv, 'p'); /* No longer an element */
434 xhv = (XPVHV*)SvANY(hv);
438 key = SvPV(keysv, klen);
441 PERL_HASH(hash, key, klen);
443 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
446 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
447 if (HeHASH(entry) != hash) /* strings can't be equal */
449 if (HeKLEN(entry) != klen)
451 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
453 *oentry = HeNEXT(entry);
456 if (flags & G_DISCARD)
459 sv = sv_mortalcopy(HeVAL(entry));
460 if (entry == xhv->xhv_eiter)
463 hv_free_ent(hv, entry);
471 hv_exists(HV *hv, char *key, U32 klen)
481 if (SvRMAGICAL(hv)) {
482 if (mg_find((SV*)hv,'P')) {
485 mg_copy((SV*)hv, sv, key, klen);
486 magic_existspack(sv, mg_find(sv, 'p'));
491 xhv = (XPVHV*)SvANY(hv);
495 PERL_HASH(hash, key, klen);
497 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
498 for (; entry; entry = HeNEXT(entry)) {
499 if (HeHASH(entry) != hash) /* strings can't be equal */
501 if (HeKLEN(entry) != klen)
503 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
512 hv_exists_ent(HV *hv, SV *keysv, U32 hash)
523 if (SvRMAGICAL(hv)) {
524 if (mg_find((SV*)hv,'P')) {
525 dTHR; /* just for SvTRUE */
527 keysv = sv_2mortal(newSVsv(keysv));
528 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
529 magic_existspack(sv, mg_find(sv, 'p'));
534 xhv = (XPVHV*)SvANY(hv);
538 key = SvPV(keysv, klen);
540 PERL_HASH(hash, key, klen);
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 */
546 if (HeKLEN(entry) != klen)
548 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
558 register XPVHV* xhv = (XPVHV*)SvANY(hv);
559 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
560 register I32 newsize = oldsize * 2;
565 register HE **oentry;
566 #ifndef STRANGE_MALLOC
570 a = (HE**)xhv->xhv_array;
572 #ifdef STRANGE_MALLOC
573 Renew(a, newsize, HE*);
575 i = newsize * sizeof(HE*);
576 #define MALLOC_OVERHEAD 16
577 tmp = MALLOC_OVERHEAD;
578 while (tmp - MALLOC_OVERHEAD < i)
580 tmp -= MALLOC_OVERHEAD;
582 assert(tmp >= newsize);
584 Copy(xhv->xhv_array, a, oldsize, HE*);
586 offer_nice_chunk(xhv->xhv_array,
587 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
590 Safefree(xhv->xhv_array);
594 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
595 xhv->xhv_max = --newsize;
596 xhv->xhv_array = (char*)a;
598 for (i=0; i<oldsize; i++,a++) {
599 if (!*a) /* non-existent */
602 for (oentry = a, entry = *a; entry; entry = *oentry) {
603 if ((HeHASH(entry) & newsize) != i) {
604 *oentry = HeNEXT(entry);
612 oentry = &HeNEXT(entry);
614 if (!*a) /* everything moved */
620 hv_ksplit(HV *hv, IV newmax)
622 register XPVHV* xhv = (XPVHV*)SvANY(hv);
623 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
624 register I32 newsize;
629 register HE **oentry;
631 newsize = (I32) newmax; /* possible truncation here */
632 if (newsize != newmax || newmax <= oldsize)
634 while ((newsize & (1 + ~newsize)) != newsize) {
635 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
637 if (newsize < newmax)
639 if (newsize < newmax)
640 return; /* overflow detection */
642 a = (HE**)xhv->xhv_array;
645 #ifdef STRANGE_MALLOC
646 Renew(a, newsize, HE*);
648 i = newsize * sizeof(HE*);
650 while (j - MALLOC_OVERHEAD < i)
652 j -= MALLOC_OVERHEAD;
654 assert(j >= newsize);
656 Copy(xhv->xhv_array, a, oldsize, HE*);
658 offer_nice_chunk(xhv->xhv_array,
659 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
662 Safefree(xhv->xhv_array);
665 Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
668 Newz(0, a, newsize, HE*);
670 xhv->xhv_max = --newsize;
671 xhv->xhv_array = (char*)a;
672 if (!xhv->xhv_fill) /* skip rest if no entries */
675 for (i=0; i<oldsize; i++,a++) {
676 if (!*a) /* non-existent */
678 for (oentry = a, entry = *a; entry; entry = *oentry) {
679 if ((j = (HeHASH(entry) & newsize)) != i) {
681 *oentry = HeNEXT(entry);
682 if (!(HeNEXT(entry) = a[j]))
688 oentry = &HeNEXT(entry);
690 if (!*a) /* everything moved */
701 hv = (HV*)NEWSV(502,0);
702 sv_upgrade((SV *)hv, SVt_PVHV);
703 xhv = (XPVHV*)SvANY(hv);
706 #ifndef NODEFAULT_SHAREKEYS
707 HvSHAREKEYS_on(hv); /* key-sharing on by default */
709 xhv->xhv_max = 7; /* start with 8 buckets */
712 (void)hv_iterinit(hv); /* so each() will start off right */
717 hv_free_ent(HV *hv, register HE *entry)
721 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
722 sub_generation++; /* may be deletion of method from stash */
723 SvREFCNT_dec(HeVAL(entry));
724 if (HeKLEN(entry) == HEf_SVKEY) {
725 SvREFCNT_dec(HeKEY_sv(entry));
726 Safefree(HeKEY_hek(entry));
728 else if (HvSHAREKEYS(hv))
729 unshare_hek(HeKEY_hek(entry));
731 Safefree(HeKEY_hek(entry));
736 hv_delayfree_ent(HV *hv, register HE *entry)
740 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
741 sub_generation++; /* may be deletion of method from stash */
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));
747 else if (HvSHAREKEYS(hv))
748 unshare_hek(HeKEY_hek(entry));
750 Safefree(HeKEY_hek(entry));
760 xhv = (XPVHV*)SvANY(hv);
765 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
776 register HE *oentry = Null(HE*);
792 entry = HeNEXT(entry);
793 hv_free_ent(hv, oentry);
798 entry = array[riter];
801 (void)hv_iterinit(hv);
810 xhv = (XPVHV*)SvANY(hv);
812 Safefree(xhv->xhv_array);
814 Safefree(HvNAME(hv));
818 xhv->xhv_max = 7; /* it's a normal hash */
834 xhv = (XPVHV*)SvANY(hv);
835 entry = xhv->xhv_eiter;
836 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
837 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
840 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
842 hv_free_ent(hv, entry);
845 xhv->xhv_eiter = Null(HE*);
846 return xhv->xhv_fill; /* should be xhv->xhv_keys? May change later */
859 xhv = (XPVHV*)SvANY(hv);
860 oldentry = entry = xhv->xhv_eiter;
862 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
863 SV *key = sv_newmortal();
865 sv_setsv(key, HeSVKEY_force(entry));
866 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
872 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
874 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
876 HeKEY_hek(entry) = hek;
877 HeKLEN(entry) = HEf_SVKEY;
879 magic_nextpack((SV*) hv,mg,key);
881 /* force key to stay around until next time */
882 HeSVKEY_set(entry, SvREFCNT_inc(key));
883 return entry; /* beware, hent_val is not set */
886 SvREFCNT_dec(HeVAL(entry));
887 Safefree(HeKEY_hek(entry));
889 xhv->xhv_eiter = Null(HE*);
894 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
896 entry = HeNEXT(entry);
899 if (xhv->xhv_riter > xhv->xhv_max) {
903 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
906 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
908 hv_free_ent(hv, oldentry);
911 xhv->xhv_eiter = entry;
916 hv_iterkey(register HE *entry, I32 *retlen)
918 if (HeKLEN(entry) == HEf_SVKEY) {
920 char *p = SvPV(HeKEY_sv(entry), len);
925 *retlen = HeKLEN(entry);
930 /* unlike hv_iterval(), this always returns a mortal copy of the key */
932 hv_iterkeysv(register HE *entry)
934 if (HeKLEN(entry) == HEf_SVKEY)
935 return sv_mortalcopy(HeKEY_sv(entry));
937 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
942 hv_iterval(HV *hv, register HE *entry)
944 if (SvRMAGICAL(hv)) {
945 if (mg_find((SV*)hv,'P')) {
946 SV* sv = sv_newmortal();
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));
957 hv_iternextsv(HV *hv, char **key, I32 *retlen)
960 if ( (he = hv_iternext(hv)) == NULL)
962 *key = hv_iterkey(he, retlen);
963 return hv_iterval(hv, he);
967 hv_magic(HV *hv, GV *gv, int how)
969 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
973 sharepvn(char *sv, I32 len, U32 hash)
975 return HEK_KEY(share_hek(sv, len, hash));
978 /* possibly free a shared string if no one has access to it
979 * len and hash must both be valid for str.
982 unsharepvn(char *str, I32 len, U32 hash)
986 register HE **oentry;
990 /* what follows is the moral equivalent of:
991 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
992 if (--*Svp == Nullsv)
993 hv_delete(strtab, str, len, G_DISCARD, hash);
995 xhv = (XPVHV*)SvANY(strtab);
996 /* assert(xhv_array != 0) */
997 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
998 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
999 if (HeHASH(entry) != hash) /* strings can't be equal */
1001 if (HeKLEN(entry) != len)
1003 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1006 if (--HeVAL(entry) == Nullsv) {
1007 *oentry = HeNEXT(entry);
1010 Safefree(HeKEY_hek(entry));
1018 warn("Attempt to free non-existent shared string");
1021 /* get a (constant) string ptr from the global string table
1022 * string will get added if it is not already there.
1023 * len and hash must both be valid for str.
1026 share_hek(char *str, I32 len, register U32 hash)
1028 register XPVHV* xhv;
1030 register HE **oentry;
1034 /* what follows is the moral equivalent of:
1036 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1037 hv_store(strtab, str, len, Nullsv, hash);
1039 xhv = (XPVHV*)SvANY(strtab);
1040 /* assert(xhv_array != 0) */
1041 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1042 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1043 if (HeHASH(entry) != hash) /* strings can't be equal */
1045 if (HeKLEN(entry) != len)
1047 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1054 HeKEY_hek(entry) = save_hek(str, len, hash);
1055 HeVAL(entry) = Nullsv;
1056 HeNEXT(entry) = *oentry;
1059 if (i) { /* initial entry? */
1061 if (xhv->xhv_keys > xhv->xhv_max)
1066 ++HeVAL(entry); /* use value slot as REFCNT */
1067 return HeKEY_hek(entry);