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);
58 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
62 hv_fetch(hv,key,klen,lval)
77 if (mg_find((SV*)hv,'P')) {
79 mg_copy((SV*)hv, sv, key, klen);
85 xhv = (XPVHV*)SvANY(hv);
86 if (!xhv->xhv_array) {
88 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
89 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
92 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
97 PERL_HASH(hash, key, klen);
99 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
100 for (; entry; entry = HeNEXT(entry)) {
101 if (HeHASH(entry) != hash) /* strings can't be equal */
103 if (HeKLEN(entry) != klen)
105 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
107 return &HeVAL(entry);
109 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
110 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
113 gotenv = my_getenv(key);
114 if (gotenv != NULL) {
115 sv = newSVpv(gotenv,strlen(gotenv));
116 return hv_store(hv,key,klen,sv,hash);
120 if (lval) { /* gonna assign to this, so it better be there */
122 return hv_store(hv,key,klen,sv,hash);
127 /* returns a HE * structure with the all fields set */
128 /* note that hent_val will be a mortal sv for MAGICAL hashes */
130 hv_fetch_ent(hv,keysv,lval,hash)
145 if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
147 keysv = sv_2mortal(newSVsv(keysv));
148 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
151 HeKEY(entry) = (char*)keysv;
152 HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */
156 xhv = (XPVHV*)SvANY(hv);
157 if (!xhv->xhv_array) {
159 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
160 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
163 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
168 key = SvPV(keysv, klen);
171 PERL_HASH(hash, key, klen);
173 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
174 for (; entry; entry = HeNEXT(entry)) {
175 if (HeHASH(entry) != hash) /* strings can't be equal */
177 if (HeKLEN(entry) != klen)
179 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
183 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
184 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
187 gotenv = my_getenv(key);
188 if (gotenv != NULL) {
189 sv = newSVpv(gotenv,strlen(gotenv));
190 return hv_store_ent(hv,keysv,sv,hash);
194 if (lval) { /* gonna assign to this, so it better be there */
196 return hv_store_ent(hv,keysv,sv,hash);
202 hv_store(hv,key,klen,val,hash)
212 register HE **oentry;
217 xhv = (XPVHV*)SvANY(hv);
219 mg_copy((SV*)hv, val, key, klen);
224 if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
225 || SvMAGIC(hv)->mg_moremagic))
227 #endif /* OVERLOAD */
230 PERL_HASH(hash, key, klen);
233 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
235 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
238 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
239 if (HeHASH(entry) != hash) /* strings can't be equal */
241 if (HeKLEN(entry) != klen)
243 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
245 SvREFCNT_dec(HeVAL(entry));
247 return &HeVAL(entry);
251 HeKLEN(entry) = klen;
253 HeKEY(entry) = sharepvn(key, klen, hash);
254 else /* gotta do the real thing */
255 HeKEY(entry) = savepvn(key,klen);
257 HeHASH(entry) = hash;
258 HeNEXT(entry) = *oentry;
262 if (i) { /* initial entry? */
264 if (xhv->xhv_keys > xhv->xhv_max)
268 return &HeVAL(entry);
272 hv_store_ent(hv,keysv,val,hash)
283 register HE **oentry;
288 xhv = (XPVHV*)SvANY(hv);
290 keysv = sv_2mortal(newSVsv(keysv));
291 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
296 if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
297 || SvMAGIC(hv)->mg_moremagic))
299 #endif /* OVERLOAD */
302 key = SvPV(keysv, klen);
305 PERL_HASH(hash, key, klen);
308 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
310 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
313 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
314 if (HeHASH(entry) != hash) /* strings can't be equal */
316 if (HeKLEN(entry) != klen)
318 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
320 SvREFCNT_dec(HeVAL(entry));
326 HeKLEN(entry) = klen;
328 HeKEY(entry) = sharepvn(key, klen, hash);
329 else /* gotta do the real thing */
330 HeKEY(entry) = savepvn(key,klen);
332 HeHASH(entry) = hash;
333 HeNEXT(entry) = *oentry;
337 if (i) { /* initial entry? */
339 if (xhv->xhv_keys > xhv->xhv_max)
347 hv_delete(hv,key,klen,flags)
357 register HE **oentry;
362 if (SvRMAGICAL(hv)) {
363 sv = *hv_fetch(hv, key, klen, TRUE);
365 if (mg_find(sv, 's')) {
366 return Nullsv; /* %SIG elements cannot be deleted */
368 if (mg_find(sv, 'p')) {
369 sv_unmagic(sv, 'p'); /* No longer an element */
373 xhv = (XPVHV*)SvANY(hv);
377 PERL_HASH(hash, key, klen);
379 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
382 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
383 if (HeHASH(entry) != hash) /* strings can't be equal */
385 if (HeKLEN(entry) != klen)
387 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
389 *oentry = HeNEXT(entry);
392 if (flags & G_DISCARD)
395 sv = sv_mortalcopy(HeVAL(entry));
396 if (entry == xhv->xhv_eiter)
399 he_free(entry, HvSHAREKEYS(hv));
407 hv_delete_ent(hv,keysv,flags,hash)
418 register HE **oentry;
423 if (SvRMAGICAL(hv)) {
424 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
427 if (mg_find(sv, 'p')) {
428 sv_unmagic(sv, 'p'); /* No longer an element */
432 xhv = (XPVHV*)SvANY(hv);
436 key = SvPV(keysv, klen);
439 PERL_HASH(hash, key, klen);
441 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
444 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
445 if (HeHASH(entry) != hash) /* strings can't be equal */
447 if (HeKLEN(entry) != klen)
449 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
451 *oentry = HeNEXT(entry);
454 if (flags & G_DISCARD)
457 sv = sv_mortalcopy(HeVAL(entry));
458 if (entry == xhv->xhv_eiter)
461 he_free(entry, HvSHAREKEYS(hv));
469 hv_exists(hv,key,klen)
482 if (SvRMAGICAL(hv)) {
483 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 (memcmp(HeKEY(entry),key,klen)) /* is this it? */
512 hv_exists_ent(hv,keysv,hash)
526 if (SvRMAGICAL(hv)) {
527 if (mg_find((SV*)hv,'P')) {
529 keysv = sv_2mortal(newSVsv(keysv));
530 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
531 magic_existspack(sv, mg_find(sv, 'p'));
536 xhv = (XPVHV*)SvANY(hv);
540 key = SvPV(keysv, klen);
542 PERL_HASH(hash, key, klen);
544 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
545 for (; entry; entry = HeNEXT(entry)) {
546 if (HeHASH(entry) != hash) /* strings can't be equal */
548 if (HeKLEN(entry) != klen)
550 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
561 register XPVHV* xhv = (XPVHV*)SvANY(hv);
562 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
563 register I32 newsize = oldsize * 2;
568 register HE **oentry;
569 #ifndef STRANGE_MALLOC
573 a = (HE**)xhv->xhv_array;
575 #ifdef STRANGE_MALLOC
576 Renew(a, newsize, HE*);
578 i = newsize * sizeof(HE*);
579 #define MALLOC_OVERHEAD 16
580 tmp = MALLOC_OVERHEAD;
581 while (tmp - MALLOC_OVERHEAD < i)
583 tmp -= MALLOC_OVERHEAD;
585 assert(tmp >= newsize);
587 Copy(xhv->xhv_array, a, oldsize, HE*);
588 if (oldsize >= 64 && !nice_chunk) {
589 nice_chunk = (char*)xhv->xhv_array;
590 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
593 Safefree(xhv->xhv_array);
597 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
598 xhv->xhv_max = --newsize;
599 xhv->xhv_array = (char*)a;
601 for (i=0; i<oldsize; i++,a++) {
602 if (!*a) /* non-existent */
605 for (oentry = a, entry = *a; entry; entry = *oentry) {
606 if ((HeHASH(entry) & newsize) != i) {
607 *oentry = HeNEXT(entry);
615 oentry = &HeNEXT(entry);
617 if (!*a) /* everything moved */
623 hv_ksplit(hv, newmax)
627 register XPVHV* xhv = (XPVHV*)SvANY(hv);
628 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
629 register I32 newsize;
634 register HE **oentry;
636 newsize = (I32) newmax; /* possible truncation here */
637 if (newsize != newmax || newmax <= oldsize)
639 while ((newsize & (1 + ~newsize)) != newsize) {
640 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
642 if (newsize < newmax)
644 if (newsize < newmax)
645 return; /* overflow detection */
647 a = (HE**)xhv->xhv_array;
650 #ifdef STRANGE_MALLOC
651 Renew(a, newsize, HE*);
653 i = newsize * sizeof(HE*);
655 while (j - MALLOC_OVERHEAD < i)
657 j -= MALLOC_OVERHEAD;
659 assert(j >= newsize);
661 Copy(xhv->xhv_array, a, oldsize, HE*);
662 if (oldsize >= 64 && !nice_chunk) {
663 nice_chunk = (char*)xhv->xhv_array;
664 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
667 Safefree(xhv->xhv_array);
670 Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
673 Newz(0, a, newsize, HE*);
675 xhv->xhv_max = --newsize;
676 xhv->xhv_array = (char*)a;
677 if (!xhv->xhv_fill) /* skip rest if no entries */
680 for (i=0; i<oldsize; i++,a++) {
681 if (!*a) /* non-existent */
683 for (oentry = a, entry = *a; entry; entry = *oentry) {
684 if ((j = (HeHASH(entry) & newsize)) != i) {
686 *oentry = HeNEXT(entry);
687 if (!(HeNEXT(entry) = a[j]))
693 oentry = &HeNEXT(entry);
695 if (!*a) /* everything moved */
706 hv = (HV*)NEWSV(502,0);
707 sv_upgrade((SV *)hv, SVt_PVHV);
708 xhv = (XPVHV*)SvANY(hv);
711 #ifndef NODEFAULT_SHAREKEYS
712 HvSHAREKEYS_on(hv); /* key-sharing on by default */
714 xhv->xhv_max = 7; /* start with 8 buckets */
717 (void)hv_iterinit(hv); /* so each() will start off right */
722 he_free(hent, shared)
728 SvREFCNT_dec(HeVAL(hent));
729 if (HeKLEN(hent) == HEf_SVKEY)
730 SvREFCNT_dec((SV*)HeKEY(hent));
732 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
734 Safefree(HeKEY(hent));
739 he_delayfree(hent, shared)
745 sv_2mortal(HeVAL(hent)); /* free between statements */
746 if (HeKLEN(hent) == HEf_SVKEY)
747 sv_2mortal((SV*)HeKEY(hent));
749 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
751 Safefree(HeKEY(hent));
762 xhv = (XPVHV*)SvANY(hv);
767 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
779 register HE *ohent = Null(HE*);
793 shared = HvSHAREKEYS(hv);
798 he_free(ohent, shared);
806 (void)hv_iterinit(hv);
816 xhv = (XPVHV*)SvANY(hv);
818 Safefree(xhv->xhv_array);
820 Safefree(HvNAME(hv));
824 xhv->xhv_max = 7; /* it's a normal associative array */
836 register XPVHV* xhv = (XPVHV*)SvANY(hv);
837 HE *entry = xhv->xhv_eiter;
838 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
839 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) prime_env_iter();
841 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
843 he_free(entry, HvSHAREKEYS(hv));
846 xhv->xhv_eiter = Null(HE*);
847 return xhv->xhv_fill;
860 croak("Bad associative array");
861 xhv = (XPVHV*)SvANY(hv);
862 oldentry = entry = xhv->xhv_eiter;
864 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
865 SV *key = sv_newmortal();
867 sv_setsv(key, HeSVKEY_force(entry));
868 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
871 xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */
873 HeKLEN(entry) = HEf_SVKEY;
875 magic_nextpack((SV*) hv,mg,key);
877 /* force key to stay around until next time */
878 HeKEY(entry) = (char*)SvREFCNT_inc(key);
879 return entry; /* beware, hent_val is not set */
882 SvREFCNT_dec(HeVAL(entry));
884 xhv->xhv_eiter = Null(HE*);
889 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
891 entry = HeNEXT(entry);
894 if (xhv->xhv_riter > xhv->xhv_max) {
898 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
901 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
903 he_free(oldentry, HvSHAREKEYS(hv));
906 xhv->xhv_eiter = entry;
911 hv_iterkey(entry,retlen)
915 if (HeKLEN(entry) == HEf_SVKEY) {
916 return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen);
919 *retlen = HeKLEN(entry);
924 /* unlike hv_iterval(), this always returns a mortal copy of the key */
929 if (HeKLEN(entry) == HEf_SVKEY)
930 return sv_mortalcopy((SV*)HeKEY(entry));
932 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
941 if (SvRMAGICAL(hv)) {
942 if (mg_find((SV*)hv,'P')) {
943 SV* sv = sv_newmortal();
944 mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
952 hv_iternextsv(hv, key, retlen)
958 if ( (he = hv_iternext(hv)) == NULL)
960 *key = hv_iterkey(he, retlen);
961 return hv_iterval(hv, he);
965 hv_magic(hv, gv, how)
970 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
973 /* get a (constant) string ptr from the global string table
974 * string will get added if it is not already there.
975 * len and hash must both be valid for str.
978 sharepvn(str, len, hash)
985 register HE **oentry;
989 /* what follows is the moral equivalent of:
991 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
992 hv_store(strtab, str, len, Nullsv, hash);
994 xhv = (XPVHV*)SvANY(strtab);
995 /* assert(xhv_array != 0) */
996 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
997 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
998 if (HeHASH(entry) != hash) /* strings can't be equal */
1000 if (HeKLEN(entry) != len)
1002 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
1009 HeKLEN(entry) = len;
1010 HeKEY(entry) = savepvn(str,len);
1011 HeVAL(entry) = Nullsv;
1012 HeHASH(entry) = hash;
1013 HeNEXT(entry) = *oentry;
1016 if (i) { /* initial entry? */
1018 if (xhv->xhv_keys > xhv->xhv_max)
1023 ++HeVAL(entry); /* use value slot as REFCNT */
1024 return HeKEY(entry);
1027 /* possibly free a shared string if no one has access to it
1028 * len and hash must both be valid for str.
1031 unsharepvn(str, len, hash)
1036 register XPVHV* xhv;
1038 register HE **oentry;
1042 /* what follows is the moral equivalent of:
1043 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1044 if (--*Svp == Nullsv)
1045 hv_delete(strtab, str, len, G_DISCARD, hash);
1047 xhv = (XPVHV*)SvANY(strtab);
1048 /* assert(xhv_array != 0) */
1049 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1050 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1051 if (HeHASH(entry) != hash) /* strings can't be equal */
1053 if (HeKLEN(entry) != len)
1055 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
1058 if (--HeVAL(entry) == Nullsv) {
1059 *oentry = HeNEXT(entry);
1062 Safefree(HeKEY(entry));
1070 warn("Attempt to free non-existent shared string");