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;
180 HeKLEN(&mh) = HEf_SVKEY; /* key will always hold an SV* */
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 gotenv = ENV_getenv(key);
219 if (gotenv != NULL) {
220 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 keysv = sv_2mortal(newSVsv(keysv));
320 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
322 && (SvMAGIC(hv)->mg_moremagic
323 || (SvMAGIC(hv)->mg_type != 'E'
325 && SvMAGIC(hv)->mg_type != 'A'
326 #endif /* OVERLOAD */
331 key = SvPV(keysv, klen);
334 PERL_HASH(hash, key, klen);
337 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
339 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
342 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
343 if (HeHASH(entry) != hash) /* strings can't be equal */
345 if (HeKLEN(entry) != klen)
347 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
349 SvREFCNT_dec(HeVAL(entry));
356 HeKEY_hek(entry) = share_hek(key, klen, hash);
357 else /* gotta do the real thing */
358 HeKEY_hek(entry) = save_hek(key, klen, hash);
360 HeNEXT(entry) = *oentry;
364 if (i) { /* initial entry? */
366 if (xhv->xhv_keys > xhv->xhv_max)
374 hv_delete(hv,key,klen,flags)
384 register HE **oentry;
389 if (SvRMAGICAL(hv)) {
390 sv = *hv_fetch(hv, key, klen, TRUE);
392 if (mg_find(sv, 's')) {
393 return Nullsv; /* %SIG elements cannot be deleted */
395 if (mg_find(sv, 'p')) {
396 sv_unmagic(sv, 'p'); /* No longer an element */
400 xhv = (XPVHV*)SvANY(hv);
404 PERL_HASH(hash, key, klen);
406 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
409 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
410 if (HeHASH(entry) != hash) /* strings can't be equal */
412 if (HeKLEN(entry) != klen)
414 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
416 *oentry = HeNEXT(entry);
419 if (flags & G_DISCARD)
422 sv = sv_mortalcopy(HeVAL(entry));
423 if (entry == xhv->xhv_eiter)
434 hv_delete_ent(hv,keysv,flags,hash)
445 register HE **oentry;
450 if (SvRMAGICAL(hv)) {
451 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
454 if (mg_find(sv, 'p')) {
455 sv_unmagic(sv, 'p'); /* No longer an element */
459 xhv = (XPVHV*)SvANY(hv);
463 key = SvPV(keysv, klen);
466 PERL_HASH(hash, key, klen);
468 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
471 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
472 if (HeHASH(entry) != hash) /* strings can't be equal */
474 if (HeKLEN(entry) != klen)
476 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
478 *oentry = HeNEXT(entry);
481 if (flags & G_DISCARD)
484 sv = sv_mortalcopy(HeVAL(entry));
485 if (entry == xhv->xhv_eiter)
496 hv_exists(hv,key,klen)
509 if (SvRMAGICAL(hv)) {
510 if (mg_find((SV*)hv,'P')) {
512 mg_copy((SV*)hv, sv, key, klen);
513 magic_existspack(sv, mg_find(sv, 'p'));
518 xhv = (XPVHV*)SvANY(hv);
522 PERL_HASH(hash, key, klen);
524 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
525 for (; entry; entry = HeNEXT(entry)) {
526 if (HeHASH(entry) != hash) /* strings can't be equal */
528 if (HeKLEN(entry) != klen)
530 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
539 hv_exists_ent(hv,keysv,hash)
553 if (SvRMAGICAL(hv)) {
554 if (mg_find((SV*)hv,'P')) {
556 keysv = sv_2mortal(newSVsv(keysv));
557 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
558 magic_existspack(sv, mg_find(sv, 'p'));
563 xhv = (XPVHV*)SvANY(hv);
567 key = SvPV(keysv, klen);
569 PERL_HASH(hash, key, klen);
571 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
572 for (; entry; entry = HeNEXT(entry)) {
573 if (HeHASH(entry) != hash) /* strings can't be equal */
575 if (HeKLEN(entry) != klen)
577 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
588 register XPVHV* xhv = (XPVHV*)SvANY(hv);
589 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
590 register I32 newsize = oldsize * 2;
595 register HE **oentry;
596 #ifndef STRANGE_MALLOC
600 a = (HE**)xhv->xhv_array;
602 #ifdef STRANGE_MALLOC
603 Renew(a, newsize, HE*);
605 i = newsize * sizeof(HE*);
606 #define MALLOC_OVERHEAD 16
607 tmp = MALLOC_OVERHEAD;
608 while (tmp - MALLOC_OVERHEAD < i)
610 tmp -= MALLOC_OVERHEAD;
612 assert(tmp >= newsize);
614 Copy(xhv->xhv_array, a, oldsize, HE*);
615 if (oldsize >= 64 && !nice_chunk) {
616 nice_chunk = (char*)xhv->xhv_array;
617 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
620 Safefree(xhv->xhv_array);
624 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
625 xhv->xhv_max = --newsize;
626 xhv->xhv_array = (char*)a;
628 for (i=0; i<oldsize; i++,a++) {
629 if (!*a) /* non-existent */
632 for (oentry = a, entry = *a; entry; entry = *oentry) {
633 if ((HeHASH(entry) & newsize) != i) {
634 *oentry = HeNEXT(entry);
642 oentry = &HeNEXT(entry);
644 if (!*a) /* everything moved */
650 hv_ksplit(hv, newmax)
654 register XPVHV* xhv = (XPVHV*)SvANY(hv);
655 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
656 register I32 newsize;
661 register HE **oentry;
663 newsize = (I32) newmax; /* possible truncation here */
664 if (newsize != newmax || newmax <= oldsize)
666 while ((newsize & (1 + ~newsize)) != newsize) {
667 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
669 if (newsize < newmax)
671 if (newsize < newmax)
672 return; /* overflow detection */
674 a = (HE**)xhv->xhv_array;
677 #ifdef STRANGE_MALLOC
678 Renew(a, newsize, HE*);
680 i = newsize * sizeof(HE*);
682 while (j - MALLOC_OVERHEAD < i)
684 j -= MALLOC_OVERHEAD;
686 assert(j >= newsize);
688 Copy(xhv->xhv_array, a, oldsize, HE*);
689 if (oldsize >= 64 && !nice_chunk) {
690 nice_chunk = (char*)xhv->xhv_array;
691 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
694 Safefree(xhv->xhv_array);
697 Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
700 Newz(0, a, newsize, HE*);
702 xhv->xhv_max = --newsize;
703 xhv->xhv_array = (char*)a;
704 if (!xhv->xhv_fill) /* skip rest if no entries */
707 for (i=0; i<oldsize; i++,a++) {
708 if (!*a) /* non-existent */
710 for (oentry = a, entry = *a; entry; entry = *oentry) {
711 if ((j = (HeHASH(entry) & newsize)) != i) {
713 *oentry = HeNEXT(entry);
714 if (!(HeNEXT(entry) = a[j]))
720 oentry = &HeNEXT(entry);
722 if (!*a) /* everything moved */
733 hv = (HV*)NEWSV(502,0);
734 sv_upgrade((SV *)hv, SVt_PVHV);
735 xhv = (XPVHV*)SvANY(hv);
738 #ifndef NODEFAULT_SHAREKEYS
739 HvSHAREKEYS_on(hv); /* key-sharing on by default */
741 xhv->xhv_max = 7; /* start with 8 buckets */
744 (void)hv_iterinit(hv); /* so each() will start off right */
755 if (isGV(HeVAL(hent)) && GvCVu(HeVAL(hent)) && HvNAME(hv))
756 sub_generation++; /* may be deletion of method from stash */
757 SvREFCNT_dec(HeVAL(hent));
758 if (HeKLEN(hent) == HEf_SVKEY) {
759 SvREFCNT_dec(HeKEY_sv(hent));
760 Safefree(HeKEY_hek(hent));
762 else if (HvSHAREKEYS(hv))
763 unshare_hek(HeKEY_hek(hent));
765 Safefree(HeKEY_hek(hent));
770 he_delayfree(hv, hent)
776 if (isGV(HeVAL(hent)) && GvCVu(HeVAL(hent)) && HvNAME(hv))
777 sub_generation++; /* may be deletion of method from stash */
778 sv_2mortal(HeVAL(hent)); /* free between statements */
779 if (HeKLEN(hent) == HEf_SVKEY) {
780 sv_2mortal(HeKEY_sv(hent));
781 Safefree(HeKEY_hek(hent));
783 else if (HvSHAREKEYS(hv))
784 unshare_hek(HeKEY_hek(hent));
786 Safefree(HeKEY_hek(hent));
797 xhv = (XPVHV*)SvANY(hv);
802 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
814 register HE *ohent = Null(HE*);
839 (void)hv_iterinit(hv);
849 xhv = (XPVHV*)SvANY(hv);
851 Safefree(xhv->xhv_array);
853 Safefree(HvNAME(hv));
857 xhv->xhv_max = 7; /* it's a normal hash */
874 xhv = (XPVHV*)SvANY(hv);
875 entry = xhv->xhv_eiter;
876 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
877 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
880 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
885 xhv->xhv_eiter = Null(HE*);
886 return xhv->xhv_fill;
900 xhv = (XPVHV*)SvANY(hv);
901 oldentry = entry = xhv->xhv_eiter;
903 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
904 SV *key = sv_newmortal();
906 sv_setsv(key, HeSVKEY_force(entry));
907 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
913 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
915 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
917 HeKEY_hek(entry) = hek;
918 HeKLEN(entry) = HEf_SVKEY;
920 magic_nextpack((SV*) hv,mg,key);
922 /* force key to stay around until next time */
923 HeSVKEY_set(entry, SvREFCNT_inc(key));
924 return entry; /* beware, hent_val is not set */
927 SvREFCNT_dec(HeVAL(entry));
928 Safefree(HeKEY_hek(entry));
930 xhv->xhv_eiter = Null(HE*);
935 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
937 entry = HeNEXT(entry);
940 if (xhv->xhv_riter > xhv->xhv_max) {
944 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
947 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
949 he_free(hv, oldentry);
952 xhv->xhv_eiter = entry;
957 hv_iterkey(entry,retlen)
961 if (HeKLEN(entry) == HEf_SVKEY) {
962 return SvPV(HeKEY_sv(entry), *(STRLEN*)retlen);
965 *retlen = HeKLEN(entry);
970 /* unlike hv_iterval(), this always returns a mortal copy of the key */
975 if (HeKLEN(entry) == HEf_SVKEY)
976 return sv_mortalcopy(HeKEY_sv(entry));
978 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
987 if (SvRMAGICAL(hv)) {
988 if (mg_find((SV*)hv,'P')) {
989 SV* sv = sv_newmortal();
990 if (HeKLEN(entry) == HEf_SVKEY)
991 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
992 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1000 hv_iternextsv(hv, key, retlen)
1006 if ( (he = hv_iternext(hv)) == NULL)
1008 *key = hv_iterkey(he, retlen);
1009 return hv_iterval(hv, he);
1013 hv_magic(hv, gv, how)
1018 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1022 sharepvn(sv, len, hash)
1027 return HEK_KEY(share_hek(sv, len, hash));
1030 /* possibly free a shared string if no one has access to it
1031 * len and hash must both be valid for str.
1034 unsharepvn(str, len, hash)
1039 register XPVHV* xhv;
1041 register HE **oentry;
1045 /* what follows is the moral equivalent of:
1046 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1047 if (--*Svp == Nullsv)
1048 hv_delete(strtab, str, len, G_DISCARD, hash);
1050 xhv = (XPVHV*)SvANY(strtab);
1051 /* assert(xhv_array != 0) */
1052 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1053 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1054 if (HeHASH(entry) != hash) /* strings can't be equal */
1056 if (HeKLEN(entry) != len)
1058 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1061 if (--HeVAL(entry) == Nullsv) {
1062 *oentry = HeNEXT(entry);
1065 Safefree(HeKEY_hek(entry));
1073 warn("Attempt to free non-existent shared string");
1076 /* get a (constant) string ptr from the global string table
1077 * string will get added if it is not already there.
1078 * len and hash must both be valid for str.
1081 share_hek(str, len, hash)
1086 register XPVHV* xhv;
1088 register HE **oentry;
1092 /* what follows is the moral equivalent of:
1094 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1095 hv_store(strtab, str, len, Nullsv, hash);
1097 xhv = (XPVHV*)SvANY(strtab);
1098 /* assert(xhv_array != 0) */
1099 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1100 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1101 if (HeHASH(entry) != hash) /* strings can't be equal */
1103 if (HeKLEN(entry) != len)
1105 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1112 HeKEY_hek(entry) = save_hek(str, len, hash);
1113 HeVAL(entry) = Nullsv;
1114 HeNEXT(entry) = *oentry;
1117 if (i) { /* initial entry? */
1119 if (xhv->xhv_keys > xhv->xhv_max)
1124 ++HeVAL(entry); /* use value slot as REFCNT */
1125 return HeKEY_hek(entry);