3 * Copyright (c) 1991-1994, 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')) {
104 mg_copy((SV*)hv, sv, key, klen);
110 xhv = (XPVHV*)SvANY(hv);
111 if (!xhv->xhv_array) {
113 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
114 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
117 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
122 PERL_HASH(hash, key, klen);
124 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
125 for (; entry; entry = HeNEXT(entry)) {
126 if (HeHASH(entry) != hash) /* strings can't be equal */
128 if (HeKLEN(entry) != klen)
130 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
132 return &HeVAL(entry);
134 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
135 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
138 gotenv = ENV_getenv(key);
139 if (gotenv != NULL) {
140 sv = newSVpv(gotenv,strlen(gotenv));
141 return hv_store(hv,key,klen,sv,hash);
145 if (lval) { /* gonna assign to this, so it better be there */
147 return hv_store(hv,key,klen,sv,hash);
152 /* returns a HE * structure with the all fields set */
153 /* note that hent_val will be a mortal sv for MAGICAL hashes */
155 hv_fetch_ent(hv,keysv,lval,hash)
170 if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
174 keysv = sv_2mortal(newSVsv(keysv));
175 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
176 if (!HeKEY_hek(&mh)) {
178 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
179 HeKEY_hek(&mh) = (HEK*)k;
181 HeSVKEY_set(&mh, keysv);
186 xhv = (XPVHV*)SvANY(hv);
187 if (!xhv->xhv_array) {
189 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
190 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
193 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
198 key = SvPV(keysv, klen);
201 PERL_HASH(hash, key, klen);
203 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
204 for (; entry; entry = HeNEXT(entry)) {
205 if (HeHASH(entry) != hash) /* strings can't be equal */
207 if (HeKLEN(entry) != klen)
209 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
213 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
214 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
217 gotenv = ENV_getenv(key);
218 if (gotenv != NULL) {
219 sv = newSVpv(gotenv,strlen(gotenv));
220 return hv_store_ent(hv,keysv,sv,hash);
224 if (lval) { /* gonna assign to this, so it better be there */
226 return hv_store_ent(hv,keysv,sv,hash);
232 hv_store(hv,key,klen,val,hash)
242 register HE **oentry;
247 xhv = (XPVHV*)SvANY(hv);
249 mg_copy((SV*)hv, val, key, klen);
251 && (SvMAGIC(hv)->mg_moremagic
252 || (SvMAGIC(hv)->mg_type != 'E'
254 && SvMAGIC(hv)->mg_type != 'A'
255 #endif /* OVERLOAD */
260 PERL_HASH(hash, key, klen);
263 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
265 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
268 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
269 if (HeHASH(entry) != hash) /* strings can't be equal */
271 if (HeKLEN(entry) != klen)
273 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
275 SvREFCNT_dec(HeVAL(entry));
277 return &HeVAL(entry);
282 HeKEY_hek(entry) = share_hek(key, klen, hash);
283 else /* gotta do the real thing */
284 HeKEY_hek(entry) = save_hek(key, klen, hash);
286 HeNEXT(entry) = *oentry;
290 if (i) { /* initial entry? */
292 if (xhv->xhv_keys > xhv->xhv_max)
296 return &HeVAL(entry);
300 hv_store_ent(hv,keysv,val,hash)
311 register HE **oentry;
316 xhv = (XPVHV*)SvANY(hv);
318 keysv = sv_2mortal(newSVsv(keysv));
319 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
321 && (SvMAGIC(hv)->mg_moremagic
322 || (SvMAGIC(hv)->mg_type != 'E'
324 && SvMAGIC(hv)->mg_type != 'A'
325 #endif /* OVERLOAD */
330 key = SvPV(keysv, klen);
333 PERL_HASH(hash, key, klen);
336 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
338 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
341 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
342 if (HeHASH(entry) != hash) /* strings can't be equal */
344 if (HeKLEN(entry) != klen)
346 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
348 SvREFCNT_dec(HeVAL(entry));
355 HeKEY_hek(entry) = share_hek(key, klen, hash);
356 else /* gotta do the real thing */
357 HeKEY_hek(entry) = save_hek(key, klen, hash);
359 HeNEXT(entry) = *oentry;
363 if (i) { /* initial entry? */
365 if (xhv->xhv_keys > xhv->xhv_max)
373 hv_delete(hv,key,klen,flags)
383 register HE **oentry;
388 if (SvRMAGICAL(hv)) {
389 sv = *hv_fetch(hv, key, klen, TRUE);
391 if (mg_find(sv, 's')) {
392 return Nullsv; /* %SIG elements cannot be deleted */
394 if (mg_find(sv, 'p')) {
395 sv_unmagic(sv, 'p'); /* No longer an element */
399 xhv = (XPVHV*)SvANY(hv);
403 PERL_HASH(hash, key, klen);
405 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
408 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
409 if (HeHASH(entry) != hash) /* strings can't be equal */
411 if (HeKLEN(entry) != klen)
413 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
415 *oentry = HeNEXT(entry);
418 if (flags & G_DISCARD)
421 sv = sv_mortalcopy(HeVAL(entry));
422 if (entry == xhv->xhv_eiter)
433 hv_delete_ent(hv,keysv,flags,hash)
444 register HE **oentry;
449 if (SvRMAGICAL(hv)) {
450 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
453 if (mg_find(sv, 'p')) {
454 sv_unmagic(sv, 'p'); /* No longer an element */
458 xhv = (XPVHV*)SvANY(hv);
462 key = SvPV(keysv, klen);
465 PERL_HASH(hash, key, klen);
467 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
470 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
471 if (HeHASH(entry) != hash) /* strings can't be equal */
473 if (HeKLEN(entry) != klen)
475 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
477 *oentry = HeNEXT(entry);
480 if (flags & G_DISCARD)
483 sv = sv_mortalcopy(HeVAL(entry));
484 if (entry == xhv->xhv_eiter)
495 hv_exists(hv,key,klen)
508 if (SvRMAGICAL(hv)) {
509 if (mg_find((SV*)hv,'P')) {
511 mg_copy((SV*)hv, sv, key, klen);
512 magic_existspack(sv, mg_find(sv, 'p'));
517 xhv = (XPVHV*)SvANY(hv);
521 PERL_HASH(hash, key, klen);
523 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
524 for (; entry; entry = HeNEXT(entry)) {
525 if (HeHASH(entry) != hash) /* strings can't be equal */
527 if (HeKLEN(entry) != klen)
529 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
538 hv_exists_ent(hv,keysv,hash)
552 if (SvRMAGICAL(hv)) {
553 if (mg_find((SV*)hv,'P')) {
555 keysv = sv_2mortal(newSVsv(keysv));
556 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
557 magic_existspack(sv, mg_find(sv, 'p'));
562 xhv = (XPVHV*)SvANY(hv);
566 key = SvPV(keysv, klen);
568 PERL_HASH(hash, key, klen);
570 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
571 for (; entry; entry = HeNEXT(entry)) {
572 if (HeHASH(entry) != hash) /* strings can't be equal */
574 if (HeKLEN(entry) != klen)
576 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
587 register XPVHV* xhv = (XPVHV*)SvANY(hv);
588 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
589 register I32 newsize = oldsize * 2;
594 register HE **oentry;
595 #ifndef STRANGE_MALLOC
599 a = (HE**)xhv->xhv_array;
601 #ifdef STRANGE_MALLOC
602 Renew(a, newsize, HE*);
604 i = newsize * sizeof(HE*);
605 #define MALLOC_OVERHEAD 16
606 tmp = MALLOC_OVERHEAD;
607 while (tmp - MALLOC_OVERHEAD < i)
609 tmp -= MALLOC_OVERHEAD;
611 assert(tmp >= newsize);
613 Copy(xhv->xhv_array, a, oldsize, HE*);
614 if (oldsize >= 64 && !nice_chunk) {
615 nice_chunk = (char*)xhv->xhv_array;
616 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
619 Safefree(xhv->xhv_array);
623 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
624 xhv->xhv_max = --newsize;
625 xhv->xhv_array = (char*)a;
627 for (i=0; i<oldsize; i++,a++) {
628 if (!*a) /* non-existent */
631 for (oentry = a, entry = *a; entry; entry = *oentry) {
632 if ((HeHASH(entry) & newsize) != i) {
633 *oentry = HeNEXT(entry);
641 oentry = &HeNEXT(entry);
643 if (!*a) /* everything moved */
649 hv_ksplit(hv, newmax)
653 register XPVHV* xhv = (XPVHV*)SvANY(hv);
654 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
655 register I32 newsize;
660 register HE **oentry;
662 newsize = (I32) newmax; /* possible truncation here */
663 if (newsize != newmax || newmax <= oldsize)
665 while ((newsize & (1 + ~newsize)) != newsize) {
666 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
668 if (newsize < newmax)
670 if (newsize < newmax)
671 return; /* overflow detection */
673 a = (HE**)xhv->xhv_array;
676 #ifdef STRANGE_MALLOC
677 Renew(a, newsize, HE*);
679 i = newsize * sizeof(HE*);
681 while (j - MALLOC_OVERHEAD < i)
683 j -= MALLOC_OVERHEAD;
685 assert(j >= newsize);
687 Copy(xhv->xhv_array, a, oldsize, HE*);
688 if (oldsize >= 64 && !nice_chunk) {
689 nice_chunk = (char*)xhv->xhv_array;
690 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
693 Safefree(xhv->xhv_array);
696 Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
699 Newz(0, a, newsize, HE*);
701 xhv->xhv_max = --newsize;
702 xhv->xhv_array = (char*)a;
703 if (!xhv->xhv_fill) /* skip rest if no entries */
706 for (i=0; i<oldsize; i++,a++) {
707 if (!*a) /* non-existent */
709 for (oentry = a, entry = *a; entry; entry = *oentry) {
710 if ((j = (HeHASH(entry) & newsize)) != i) {
712 *oentry = HeNEXT(entry);
713 if (!(HeNEXT(entry) = a[j]))
719 oentry = &HeNEXT(entry);
721 if (!*a) /* everything moved */
732 hv = (HV*)NEWSV(502,0);
733 sv_upgrade((SV *)hv, SVt_PVHV);
734 xhv = (XPVHV*)SvANY(hv);
737 #ifndef NODEFAULT_SHAREKEYS
738 HvSHAREKEYS_on(hv); /* key-sharing on by default */
740 xhv->xhv_max = 7; /* start with 8 buckets */
743 (void)hv_iterinit(hv); /* so each() will start off right */
754 if (isGV(HeVAL(hent)) && GvCVu(HeVAL(hent)) && HvNAME(hv))
755 sub_generation++; /* may be deletion of method from stash */
756 SvREFCNT_dec(HeVAL(hent));
757 if (HeKLEN(hent) == HEf_SVKEY) {
758 SvREFCNT_dec(HeKEY_sv(hent));
759 Safefree(HeKEY_hek(hent));
761 else if (HvSHAREKEYS(hv))
762 unshare_hek(HeKEY_hek(hent));
764 Safefree(HeKEY_hek(hent));
769 he_delayfree(hv, hent)
775 if (isGV(HeVAL(hent)) && GvCVu(HeVAL(hent)) && HvNAME(hv))
776 sub_generation++; /* may be deletion of method from stash */
777 sv_2mortal(HeVAL(hent)); /* free between statements */
778 if (HeKLEN(hent) == HEf_SVKEY) {
779 sv_2mortal(HeKEY_sv(hent));
780 Safefree(HeKEY_hek(hent));
782 else if (HvSHAREKEYS(hv))
783 unshare_hek(HeKEY_hek(hent));
785 Safefree(HeKEY_hek(hent));
796 xhv = (XPVHV*)SvANY(hv);
801 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
813 register HE *ohent = Null(HE*);
838 (void)hv_iterinit(hv);
848 xhv = (XPVHV*)SvANY(hv);
850 Safefree(xhv->xhv_array);
852 Safefree(HvNAME(hv));
856 xhv->xhv_max = 7; /* it's a normal hash */
873 xhv = (XPVHV*)SvANY(hv);
874 entry = xhv->xhv_eiter;
875 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
876 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
879 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
884 xhv->xhv_eiter = Null(HE*);
885 return xhv->xhv_fill;
899 xhv = (XPVHV*)SvANY(hv);
900 oldentry = entry = xhv->xhv_eiter;
902 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
903 SV *key = sv_newmortal();
905 sv_setsv(key, HeSVKEY_force(entry));
906 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
912 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
914 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
916 HeKEY_hek(entry) = hek;
917 HeKLEN(entry) = HEf_SVKEY;
919 magic_nextpack((SV*) hv,mg,key);
921 /* force key to stay around until next time */
922 HeSVKEY_set(entry, SvREFCNT_inc(key));
923 return entry; /* beware, hent_val is not set */
926 SvREFCNT_dec(HeVAL(entry));
927 Safefree(HeKEY_hek(entry));
929 xhv->xhv_eiter = Null(HE*);
934 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
936 entry = HeNEXT(entry);
939 if (xhv->xhv_riter > xhv->xhv_max) {
943 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
946 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
948 he_free(hv, oldentry);
951 xhv->xhv_eiter = entry;
956 hv_iterkey(entry,retlen)
960 if (HeKLEN(entry) == HEf_SVKEY) {
961 return SvPV(HeKEY_sv(entry), *(STRLEN*)retlen);
964 *retlen = HeKLEN(entry);
969 /* unlike hv_iterval(), this always returns a mortal copy of the key */
974 if (HeKLEN(entry) == HEf_SVKEY)
975 return sv_mortalcopy(HeKEY_sv(entry));
977 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
986 if (SvRMAGICAL(hv)) {
987 if (mg_find((SV*)hv,'P')) {
988 SV* sv = sv_newmortal();
989 if (HeKLEN(entry) == HEf_SVKEY)
990 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
991 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
999 hv_iternextsv(hv, key, retlen)
1005 if ( (he = hv_iternext(hv)) == NULL)
1007 *key = hv_iterkey(he, retlen);
1008 return hv_iterval(hv, he);
1012 hv_magic(hv, gv, how)
1017 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1021 sharepvn(sv, len, hash)
1026 return HEK_KEY(share_hek(sv, len, hash));
1029 /* possibly free a shared string if no one has access to it
1030 * len and hash must both be valid for str.
1033 unsharepvn(str, len, hash)
1038 register XPVHV* xhv;
1040 register HE **oentry;
1044 /* what follows is the moral equivalent of:
1045 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1046 if (--*Svp == Nullsv)
1047 hv_delete(strtab, str, len, G_DISCARD, hash);
1049 xhv = (XPVHV*)SvANY(strtab);
1050 /* assert(xhv_array != 0) */
1051 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1052 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1053 if (HeHASH(entry) != hash) /* strings can't be equal */
1055 if (HeKLEN(entry) != len)
1057 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1060 if (--HeVAL(entry) == Nullsv) {
1061 *oentry = HeNEXT(entry);
1064 Safefree(HeKEY_hek(entry));
1072 warn("Attempt to free non-existent shared string");
1075 /* get a (constant) string ptr from the global string table
1076 * string will get added if it is not already there.
1077 * len and hash must both be valid for str.
1080 share_hek(str, len, hash)
1085 register XPVHV* xhv;
1087 register HE **oentry;
1091 /* what follows is the moral equivalent of:
1093 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1094 hv_store(strtab, str, len, Nullsv, hash);
1096 xhv = (XPVHV*)SvANY(strtab);
1097 /* assert(xhv_array != 0) */
1098 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1099 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1100 if (HeHASH(entry) != hash) /* strings can't be equal */
1102 if (HeKLEN(entry) != len)
1104 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1111 HeKEY_hek(entry) = save_hek(str, len, hash);
1112 HeVAL(entry) = Nullsv;
1113 HeNEXT(entry) = *oentry;
1116 if (i) { /* initial entry? */
1118 if (xhv->xhv_keys > xhv->xhv_max)
1123 ++HeVAL(entry); /* use value slot as REFCNT */
1124 return HeKEY_hek(entry);