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 xhv = (XPVHV*)SvANY(hv);
147 if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
149 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
152 HeKEY(entry) = (char*)keysv;
153 HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */
157 key = SvPV(keysv, klen);
160 PERL_HASH(hash, key, klen);
162 if (!xhv->xhv_array) {
164 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
165 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
168 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
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 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
295 if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
296 || SvMAGIC(hv)->mg_moremagic))
298 #endif /* OVERLOAD */
301 key = SvPV(keysv, klen);
304 PERL_HASH(hash, key, klen);
307 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
309 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
312 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
313 if (HeHASH(entry) != hash) /* strings can't be equal */
315 if (HeKLEN(entry) != klen)
317 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
319 SvREFCNT_dec(HeVAL(entry));
325 HeKLEN(entry) = klen;
327 HeKEY(entry) = sharepvn(key, klen, hash);
328 else /* gotta do the real thing */
329 HeKEY(entry) = savepvn(key,klen);
331 HeHASH(entry) = hash;
332 HeNEXT(entry) = *oentry;
336 if (i) { /* initial entry? */
338 if (xhv->xhv_keys > xhv->xhv_max)
346 hv_delete(hv,key,klen,flags)
356 register HE **oentry;
361 if (SvRMAGICAL(hv)) {
362 sv = *hv_fetch(hv, key, klen, TRUE);
364 if (mg_find(sv, 's')) {
365 return Nullsv; /* %SIG elements cannot be deleted */
367 if (mg_find(sv, 'p')) {
368 sv_unmagic(sv, 'p'); /* No longer an element */
372 xhv = (XPVHV*)SvANY(hv);
376 PERL_HASH(hash, key, klen);
378 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
381 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
382 if (HeHASH(entry) != hash) /* strings can't be equal */
384 if (HeKLEN(entry) != klen)
386 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
388 *oentry = HeNEXT(entry);
391 if (flags & G_DISCARD)
394 sv = sv_mortalcopy(HeVAL(entry));
395 if (entry == xhv->xhv_eiter)
396 HeKLEN(entry) = HEf_LAZYDEL;
398 he_free(entry, HvSHAREKEYS(hv));
406 hv_delete_ent(hv,keysv,flags,hash)
417 register HE **oentry;
422 if (SvRMAGICAL(hv)) {
423 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
426 if (mg_find(sv, 'p')) {
427 sv_unmagic(sv, 'p'); /* No longer an element */
431 xhv = (XPVHV*)SvANY(hv);
435 key = SvPV(keysv, klen);
438 PERL_HASH(hash, key, klen);
440 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
443 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
444 if (HeHASH(entry) != hash) /* strings can't be equal */
446 if (HeKLEN(entry) != klen)
448 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
450 *oentry = HeNEXT(entry);
453 if (flags & G_DISCARD)
456 sv = sv_mortalcopy(HeVAL(entry));
457 if (entry == xhv->xhv_eiter)
458 HeKLEN(entry) = HEf_LAZYDEL;
460 he_free(entry, HvSHAREKEYS(hv));
468 hv_exists(hv,key,klen)
481 if (SvRMAGICAL(hv)) {
482 if (mg_find((SV*)hv,'P')) {
484 mg_copy((SV*)hv, sv, key, klen);
485 magic_existspack(sv, mg_find(sv, 'p'));
490 xhv = (XPVHV*)SvANY(hv);
494 PERL_HASH(hash, key, klen);
496 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
497 for (; entry; entry = HeNEXT(entry)) {
498 if (HeHASH(entry) != hash) /* strings can't be equal */
500 if (HeKLEN(entry) != klen)
502 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
511 hv_exists_ent(hv,keysv,hash)
525 if (SvRMAGICAL(hv)) {
526 if (mg_find((SV*)hv,'P')) {
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 (memcmp(HeKEY(entry),key,klen)) /* is this it? */
559 register XPVHV* xhv = (XPVHV*)SvANY(hv);
560 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
561 register I32 newsize = oldsize * 2;
566 register HE **oentry;
567 #ifndef STRANGE_MALLOC
571 a = (HE**)xhv->xhv_array;
573 #ifdef STRANGE_MALLOC
574 Renew(a, newsize, HE*);
576 i = newsize * sizeof(HE*);
577 #define MALLOC_OVERHEAD 16
578 tmp = MALLOC_OVERHEAD;
579 while (tmp - MALLOC_OVERHEAD < i)
581 tmp -= MALLOC_OVERHEAD;
583 assert(tmp >= newsize);
585 Copy(xhv->xhv_array, a, oldsize, HE*);
586 if (oldsize >= 64 && !nice_chunk) {
587 nice_chunk = (char*)xhv->xhv_array;
588 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
591 Safefree(xhv->xhv_array);
595 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
596 xhv->xhv_max = --newsize;
597 xhv->xhv_array = (char*)a;
599 for (i=0; i<oldsize; i++,a++) {
600 if (!*a) /* non-existent */
603 for (oentry = a, entry = *a; entry; entry = *oentry) {
604 if ((HeHASH(entry) & newsize) != i) {
605 *oentry = HeNEXT(entry);
613 oentry = &HeNEXT(entry);
615 if (!*a) /* everything moved */
626 hv = (HV*)NEWSV(502,0);
627 sv_upgrade((SV *)hv, SVt_PVHV);
628 xhv = (XPVHV*)SvANY(hv);
631 #ifndef NODEFAULT_SHAREKEYS
632 HvSHAREKEYS_on(hv); /* key-sharing on by default */
634 xhv->xhv_max = 7; /* start with 8 buckets */
637 (void)hv_iterinit(hv); /* so each() will start off right */
642 he_free(hent, shared)
648 SvREFCNT_dec(HeVAL(hent));
649 if (HeKLEN(hent) == HEf_SVKEY)
650 SvREFCNT_dec((SV*)HeKEY(hent));
652 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
654 Safefree(HeKEY(hent));
659 he_delayfree(hent, shared)
665 sv_2mortal(HeVAL(hent)); /* free between statements */
666 if (HeKLEN(hent) == HEf_SVKEY)
667 sv_2mortal((SV*)HeKEY(hent));
669 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
671 Safefree(HeKEY(hent));
682 xhv = (XPVHV*)SvANY(hv);
687 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
699 register HE *ohent = Null(HE*);
713 shared = HvSHAREKEYS(hv);
718 he_free(ohent, shared);
726 (void)hv_iterinit(hv);
736 xhv = (XPVHV*)SvANY(hv);
738 Safefree(xhv->xhv_array);
740 Safefree(HvNAME(hv));
744 xhv->xhv_max = 7; /* it's a normal associative array */
756 register XPVHV* xhv = (XPVHV*)SvANY(hv);
757 HE *entry = xhv->xhv_eiter;
758 if (entry && HeKLEN(entry) == HEf_LAZYDEL) /* was deleted earlier? */
759 he_free(entry, HvSHAREKEYS(hv));
761 xhv->xhv_eiter = Null(HE*);
762 return xhv->xhv_fill;
775 croak("Bad associative array");
776 xhv = (XPVHV*)SvANY(hv);
777 oldentry = entry = xhv->xhv_eiter;
779 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
780 SV *key = sv_newmortal();
782 sv_setsv(key, HeSVKEY_force(entry));
783 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
786 xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */
788 HeKLEN(entry) = HEf_SVKEY;
790 magic_nextpack((SV*) hv,mg,key);
792 /* force key to stay around until next time */
793 HeKEY(entry) = (char*)SvREFCNT_inc(key);
794 return entry; /* beware, hent_val is not set */
797 SvREFCNT_dec(HeVAL(entry));
799 xhv->xhv_eiter = Null(HE*);
804 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
806 entry = HeNEXT(entry);
809 if (xhv->xhv_riter > xhv->xhv_max) {
813 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
816 if (oldentry && HeKLEN(oldentry) == HEf_LAZYDEL) /* was deleted earlier? */
817 he_free(oldentry, HvSHAREKEYS(hv));
819 xhv->xhv_eiter = entry;
824 hv_iterkey(entry,retlen)
828 if (HeKLEN(entry) == HEf_SVKEY) {
829 return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen);
832 *retlen = HeKLEN(entry);
837 /* unlike hv_iterval(), this always returns a mortal copy of the key */
842 if (HeKLEN(entry) == HEf_SVKEY)
843 return sv_mortalcopy((SV*)HeKEY(entry));
845 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
854 if (SvRMAGICAL(hv)) {
855 if (mg_find((SV*)hv,'P')) {
856 SV* sv = sv_newmortal();
857 mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
865 hv_iternextsv(hv, key, retlen)
871 if ( (he = hv_iternext(hv)) == NULL)
873 *key = hv_iterkey(he, retlen);
874 return hv_iterval(hv, he);
878 hv_magic(hv, gv, how)
883 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
886 /* get a (constant) string ptr from the global string table
887 * string will get added if it is not already there.
888 * len and hash must both be valid for str.
891 sharepvn(str, len, hash)
898 register HE **oentry;
902 /* what follows is the moral equivalent of:
904 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
905 hv_store(strtab, str, len, Nullsv, hash);
907 xhv = (XPVHV*)SvANY(strtab);
908 /* assert(xhv_array != 0) */
909 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
910 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
911 if (HeHASH(entry) != hash) /* strings can't be equal */
913 if (HeKLEN(entry) != len)
915 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
923 HeKEY(entry) = savepvn(str,len);
924 HeVAL(entry) = Nullsv;
925 HeHASH(entry) = hash;
926 HeNEXT(entry) = *oentry;
929 if (i) { /* initial entry? */
931 if (xhv->xhv_keys > xhv->xhv_max)
936 ++HeVAL(entry); /* use value slot as REFCNT */
940 /* possibly free a shared string if no one has access to it
941 * len and hash must both be valid for str.
944 unsharepvn(str, len, hash)
951 register HE **oentry;
955 /* what follows is the moral equivalent of:
956 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
957 if (--*Svp == Nullsv)
958 hv_delete(strtab, str, len, G_DISCARD, hash);
960 xhv = (XPVHV*)SvANY(strtab);
961 /* assert(xhv_array != 0) */
962 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
963 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
964 if (HeHASH(entry) != hash) /* strings can't be equal */
966 if (HeKLEN(entry) != len)
968 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
971 if (--HeVAL(entry) == Nullsv) {
972 *oentry = HeNEXT(entry);
975 Safefree(HeKEY(entry));
983 warn("Attempt to free non-existent shared string");