3 * Copyright (c) 1991-1999, 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 hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
19 static void hsplit _((HV *hv));
20 static void hfreeentries _((HV *hv));
21 static void more_he _((void));
22 static HEK *save_hek _((const char *str, I32 len, U32 hash));
25 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
26 # define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) )
28 # define MALLOC_OVERHEAD 16
29 # define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
40 PL_he_root = HeNEXT(he);
49 HeNEXT(p) = (HE*)PL_he_root;
59 New(54, PL_he_root, 1008/sizeof(HE), HE);
61 heend = &he[1008 / sizeof(HE) - 1];
63 HeNEXT(he) = (HE*)(he + 1);
70 save_hek(const char *str, I32 len, U32 hash)
75 New(54, k, HEK_BASESIZE + len + 1, char);
77 Copy(str, HEK_KEY(hek), len, char);
78 *(HEK_KEY(hek) + len) = '\0';
87 unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
90 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
94 hv_fetch(HV *hv, const char *key, U32 klen, I32 lval)
104 if (SvRMAGICAL(hv)) {
105 if (mg_find((SV*)hv,'P')) {
108 mg_copy((SV*)hv, sv, key, klen);
110 return &PL_hv_fetch_sv;
112 #ifdef ENV_IS_CASELESS
113 else if (mg_find((SV*)hv,'E')) {
115 for (i = 0; i < klen; ++i)
116 if (isLOWER(key[i])) {
117 char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen))));
118 SV **ret = hv_fetch(hv, nkey, klen, 0);
120 ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
127 xhv = (XPVHV*)SvANY(hv);
128 if (!xhv->xhv_array) {
130 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
131 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
134 Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
139 PERL_HASH(hash, key, klen);
141 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
142 for (; entry; entry = HeNEXT(entry)) {
143 if (HeHASH(entry) != hash) /* strings can't be equal */
145 if (HeKLEN(entry) != klen)
147 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
149 return &HeVAL(entry);
151 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
152 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
153 if ((sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
155 return hv_store(hv,key,klen,sv,hash);
159 if (lval) { /* gonna assign to this, so it better be there */
161 return hv_store(hv,key,klen,sv,hash);
166 /* returns a HE * structure with the all fields set */
167 /* note that hent_val will be a mortal sv for MAGICAL hashes */
169 hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
180 if (SvRMAGICAL(hv)) {
181 if (mg_find((SV*)hv,'P')) {
184 keysv = sv_2mortal(newSVsv(keysv));
185 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
186 if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
188 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
189 HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
191 HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
192 HeVAL(&PL_hv_fetch_ent_mh) = sv;
193 return &PL_hv_fetch_ent_mh;
195 #ifdef ENV_IS_CASELESS
196 else if (mg_find((SV*)hv,'E')) {
198 key = SvPV(keysv, klen);
199 for (i = 0; i < klen; ++i)
200 if (isLOWER(key[i])) {
201 SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
202 (void)strupr(SvPVX(nkeysv));
203 entry = hv_fetch_ent(hv, nkeysv, 0, 0);
205 entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
212 xhv = (XPVHV*)SvANY(hv);
213 if (!xhv->xhv_array) {
215 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
216 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
219 Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
224 key = SvPV(keysv, klen);
227 PERL_HASH(hash, key, klen);
229 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
230 for (; entry; entry = HeNEXT(entry)) {
231 if (HeHASH(entry) != hash) /* strings can't be equal */
233 if (HeKLEN(entry) != klen)
235 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
239 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
240 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
241 if ((sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
243 return hv_store_ent(hv,keysv,sv,hash);
247 if (lval) { /* gonna assign to this, so it better be there */
249 return hv_store_ent(hv,keysv,sv,hash);
255 hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store)
257 MAGIC *mg = SvMAGIC(hv);
261 if (isUPPER(mg->mg_type)) {
263 switch (mg->mg_type) {
266 *needs_store = FALSE;
269 mg = mg->mg_moremagic;
274 hv_store(HV *hv, const char *key, U32 klen, SV *val, register U32 hash)
279 register HE **oentry;
284 xhv = (XPVHV*)SvANY(hv);
288 hv_magic_check (hv, &needs_copy, &needs_store);
290 mg_copy((SV*)hv, val, key, klen);
291 if (!xhv->xhv_array && !needs_store)
293 #ifdef ENV_IS_CASELESS
294 else if (mg_find((SV*)hv,'E')) {
295 SV *sv = sv_2mortal(newSVpvn(key,klen));
296 key = strupr(SvPVX(sv));
303 PERL_HASH(hash, key, klen);
306 Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
308 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
311 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
312 if (HeHASH(entry) != hash) /* strings can't be equal */
314 if (HeKLEN(entry) != klen)
316 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
318 SvREFCNT_dec(HeVAL(entry));
320 return &HeVAL(entry);
325 HeKEY_hek(entry) = share_hek(key, klen, hash);
326 else /* gotta do the real thing */
327 HeKEY_hek(entry) = save_hek(key, klen, hash);
329 HeNEXT(entry) = *oentry;
333 if (i) { /* initial entry? */
335 if (xhv->xhv_keys > xhv->xhv_max)
339 return &HeVAL(entry);
343 hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
350 register HE **oentry;
355 xhv = (XPVHV*)SvANY(hv);
360 hv_magic_check (hv, &needs_copy, &needs_store);
362 bool save_taint = PL_tainted;
364 PL_tainted = SvTAINTED(keysv);
365 keysv = sv_2mortal(newSVsv(keysv));
366 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
367 TAINT_IF(save_taint);
368 if (!xhv->xhv_array && !needs_store)
370 #ifdef ENV_IS_CASELESS
371 else if (mg_find((SV*)hv,'E')) {
372 key = SvPV(keysv, klen);
373 keysv = sv_2mortal(newSVpvn(key,klen));
374 (void)strupr(SvPVX(keysv));
381 key = SvPV(keysv, klen);
384 PERL_HASH(hash, key, klen);
387 Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
389 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
392 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
393 if (HeHASH(entry) != hash) /* strings can't be equal */
395 if (HeKLEN(entry) != klen)
397 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
399 SvREFCNT_dec(HeVAL(entry));
406 HeKEY_hek(entry) = share_hek(key, klen, hash);
407 else /* gotta do the real thing */
408 HeKEY_hek(entry) = save_hek(key, klen, hash);
410 HeNEXT(entry) = *oentry;
414 if (i) { /* initial entry? */
416 if (xhv->xhv_keys > xhv->xhv_max)
424 hv_delete(HV *hv, const char *key, U32 klen, I32 flags)
430 register HE **oentry;
436 if (SvRMAGICAL(hv)) {
439 hv_magic_check (hv, &needs_copy, &needs_store);
441 if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
445 if (mg_find(sv, 'p')) {
446 sv_unmagic(sv, 'p'); /* No longer an element */
449 return Nullsv; /* element cannot be deleted */
451 #ifdef ENV_IS_CASELESS
452 else if (mg_find((SV*)hv,'E')) {
453 sv = sv_2mortal(newSVpvn(key,klen));
454 key = strupr(SvPVX(sv));
459 xhv = (XPVHV*)SvANY(hv);
463 PERL_HASH(hash, key, klen);
465 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
468 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
469 if (HeHASH(entry) != hash) /* strings can't be equal */
471 if (HeKLEN(entry) != klen)
473 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
475 *oentry = HeNEXT(entry);
478 if (flags & G_DISCARD)
481 sv = sv_mortalcopy(HeVAL(entry));
482 if (entry == xhv->xhv_eiter)
485 hv_free_ent(hv, entry);
493 hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
500 register HE **oentry;
505 if (SvRMAGICAL(hv)) {
508 hv_magic_check (hv, &needs_copy, &needs_store);
510 if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
514 if (mg_find(sv, 'p')) {
515 sv_unmagic(sv, 'p'); /* No longer an element */
518 return Nullsv; /* element cannot be deleted */
520 #ifdef ENV_IS_CASELESS
521 else if (mg_find((SV*)hv,'E')) {
522 key = SvPV(keysv, klen);
523 keysv = sv_2mortal(newSVpvn(key,klen));
524 (void)strupr(SvPVX(keysv));
530 xhv = (XPVHV*)SvANY(hv);
534 key = SvPV(keysv, klen);
537 PERL_HASH(hash, key, klen);
539 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
542 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
543 if (HeHASH(entry) != hash) /* strings can't be equal */
545 if (HeKLEN(entry) != klen)
547 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
549 *oentry = HeNEXT(entry);
552 if (flags & G_DISCARD)
555 sv = sv_mortalcopy(HeVAL(entry));
556 if (entry == xhv->xhv_eiter)
559 hv_free_ent(hv, entry);
567 hv_exists(HV *hv, const char *key, U32 klen)
577 if (SvRMAGICAL(hv)) {
578 if (mg_find((SV*)hv,'P')) {
581 mg_copy((SV*)hv, sv, key, klen);
582 magic_existspack(sv, mg_find(sv, 'p'));
585 #ifdef ENV_IS_CASELESS
586 else if (mg_find((SV*)hv,'E')) {
587 sv = sv_2mortal(newSVpvn(key,klen));
588 key = strupr(SvPVX(sv));
593 xhv = (XPVHV*)SvANY(hv);
594 #ifndef DYNAMIC_ENV_FETCH
599 PERL_HASH(hash, key, klen);
601 #ifdef DYNAMIC_ENV_FETCH
602 if (!xhv->xhv_array) entry = Null(HE*);
605 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
606 for (; entry; entry = HeNEXT(entry)) {
607 if (HeHASH(entry) != hash) /* strings can't be equal */
609 if (HeKLEN(entry) != klen)
611 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
615 #ifdef DYNAMIC_ENV_FETCH /* is it out there? */
616 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME) &&
617 (sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
619 hv_store(hv,key,klen,sv,hash);
628 hv_exists_ent(HV *hv, SV *keysv, U32 hash)
639 if (SvRMAGICAL(hv)) {
640 if (mg_find((SV*)hv,'P')) {
641 dTHR; /* just for SvTRUE */
643 keysv = sv_2mortal(newSVsv(keysv));
644 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
645 magic_existspack(sv, mg_find(sv, 'p'));
648 #ifdef ENV_IS_CASELESS
649 else if (mg_find((SV*)hv,'E')) {
650 key = SvPV(keysv, klen);
651 keysv = sv_2mortal(newSVpvn(key,klen));
652 (void)strupr(SvPVX(keysv));
658 xhv = (XPVHV*)SvANY(hv);
659 #ifndef DYNAMIC_ENV_FETCH
664 key = SvPV(keysv, klen);
666 PERL_HASH(hash, key, klen);
668 #ifdef DYNAMIC_ENV_FETCH
669 if (!xhv->xhv_array) entry = Null(HE*);
672 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
673 for (; entry; entry = HeNEXT(entry)) {
674 if (HeHASH(entry) != hash) /* strings can't be equal */
676 if (HeKLEN(entry) != klen)
678 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
682 #ifdef DYNAMIC_ENV_FETCH /* is it out there? */
683 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME) &&
684 (sv = PerlEnv_ENVgetenv_sv(key)) != &PL_sv_undef) {
686 hv_store_ent(hv,keysv,sv,hash);
696 register XPVHV* xhv = (XPVHV*)SvANY(hv);
697 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
698 register I32 newsize = oldsize * 2;
700 register char *a = xhv->xhv_array;
704 register HE **oentry;
707 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
708 Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
714 #define MALLOC_OVERHEAD 16
715 New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
720 Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
722 offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
725 Safefree(xhv->xhv_array);
729 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
730 xhv->xhv_max = --newsize;
734 for (i=0; i<oldsize; i++,aep++) {
735 if (!*aep) /* non-existent */
738 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
739 if ((HeHASH(entry) & newsize) != i) {
740 *oentry = HeNEXT(entry);
741 HeNEXT(entry) = *bep;
748 oentry = &HeNEXT(entry);
750 if (!*aep) /* everything moved */
756 hv_ksplit(HV *hv, IV newmax)
758 register XPVHV* xhv = (XPVHV*)SvANY(hv);
759 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
760 register I32 newsize;
766 register HE **oentry;
768 newsize = (I32) newmax; /* possible truncation here */
769 if (newsize != newmax || newmax <= oldsize)
771 while ((newsize & (1 + ~newsize)) != newsize) {
772 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
774 if (newsize < newmax)
776 if (newsize < newmax)
777 return; /* overflow detection */
782 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
783 Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
789 New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
794 Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
796 offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
799 Safefree(xhv->xhv_array);
802 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
805 Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char);
807 xhv->xhv_max = --newsize;
809 if (!xhv->xhv_fill) /* skip rest if no entries */
813 for (i=0; i<oldsize; i++,aep++) {
814 if (!*aep) /* non-existent */
816 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
817 if ((j = (HeHASH(entry) & newsize)) != i) {
819 *oentry = HeNEXT(entry);
820 if (!(HeNEXT(entry) = aep[j]))
826 oentry = &HeNEXT(entry);
828 if (!*aep) /* everything moved */
839 hv = (HV*)NEWSV(502,0);
840 sv_upgrade((SV *)hv, SVt_PVHV);
841 xhv = (XPVHV*)SvANY(hv);
844 #ifndef NODEFAULT_SHAREKEYS
845 HvSHAREKEYS_on(hv); /* key-sharing on by default */
847 xhv->xhv_max = 7; /* start with 8 buckets */
850 (void)hv_iterinit(hv); /* so each() will start off right */
858 STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
859 STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
862 while (hv_max && hv_max + 1 >= hv_fill * 2)
863 hv_max = hv_max / 2; /* Is always 2^n-1 */
869 if (! SvTIED_mg((SV*)ohv, 'P')) {
876 I32 hv_riter = HvRITER(ohv); /* current root of iterator */
877 HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
881 while (entry = hv_iternext(ohv)) {
882 hv_store(hv, HeKEY(entry), HeKLEN(entry),
883 SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
885 HvRITER(ohv) = hv_riter;
886 HvEITER(ohv) = hv_eiter;
893 hv_free_ent(HV *hv, register HE *entry)
900 if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
901 PL_sub_generation++; /* may be deletion of method from stash */
903 if (HeKLEN(entry) == HEf_SVKEY) {
904 SvREFCNT_dec(HeKEY_sv(entry));
905 Safefree(HeKEY_hek(entry));
907 else if (HvSHAREKEYS(hv))
908 unshare_hek(HeKEY_hek(entry));
910 Safefree(HeKEY_hek(entry));
915 hv_delayfree_ent(HV *hv, register HE *entry)
919 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
920 PL_sub_generation++; /* may be deletion of method from stash */
921 sv_2mortal(HeVAL(entry)); /* free between statements */
922 if (HeKLEN(entry) == HEf_SVKEY) {
923 sv_2mortal(HeKEY_sv(entry));
924 Safefree(HeKEY_hek(entry));
926 else if (HvSHAREKEYS(hv))
927 unshare_hek(HeKEY_hek(entry));
929 Safefree(HeKEY_hek(entry));
939 xhv = (XPVHV*)SvANY(hv);
944 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
955 register HE *oentry = Null(HE*);
971 entry = HeNEXT(entry);
972 hv_free_ent(hv, oentry);
977 entry = array[riter];
980 (void)hv_iterinit(hv);
989 xhv = (XPVHV*)SvANY(hv);
991 Safefree(xhv->xhv_array);
993 Safefree(HvNAME(hv));
997 xhv->xhv_max = 7; /* it's a normal hash */
1008 register XPVHV* xhv;
1013 xhv = (XPVHV*)SvANY(hv);
1014 entry = xhv->xhv_eiter;
1015 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
1017 hv_free_ent(hv, entry);
1019 xhv->xhv_riter = -1;
1020 xhv->xhv_eiter = Null(HE*);
1021 return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */
1027 register XPVHV* xhv;
1034 xhv = (XPVHV*)SvANY(hv);
1035 oldentry = entry = xhv->xhv_eiter;
1037 if (mg = SvTIED_mg((SV*)hv, 'P')) {
1038 SV *key = sv_newmortal();
1040 sv_setsv(key, HeSVKEY_force(entry));
1041 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
1047 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
1049 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
1051 HeKEY_hek(entry) = hek;
1052 HeKLEN(entry) = HEf_SVKEY;
1054 magic_nextpack((SV*) hv,mg,key);
1056 /* force key to stay around until next time */
1057 HeSVKEY_set(entry, SvREFCNT_inc(key));
1058 return entry; /* beware, hent_val is not set */
1061 SvREFCNT_dec(HeVAL(entry));
1062 Safefree(HeKEY_hek(entry));
1064 xhv->xhv_eiter = Null(HE*);
1067 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
1068 if (!entry && HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
1072 if (!xhv->xhv_array)
1073 Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
1075 entry = HeNEXT(entry);
1078 if (xhv->xhv_riter > xhv->xhv_max) {
1079 xhv->xhv_riter = -1;
1082 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1085 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
1087 hv_free_ent(hv, oldentry);
1090 xhv->xhv_eiter = entry;
1095 hv_iterkey(register HE *entry, I32 *retlen)
1097 if (HeKLEN(entry) == HEf_SVKEY) {
1099 char *p = SvPV(HeKEY_sv(entry), len);
1104 *retlen = HeKLEN(entry);
1105 return HeKEY(entry);
1109 /* unlike hv_iterval(), this always returns a mortal copy of the key */
1111 hv_iterkeysv(register HE *entry)
1113 if (HeKLEN(entry) == HEf_SVKEY)
1114 return sv_mortalcopy(HeKEY_sv(entry));
1116 return sv_2mortal(newSVpvn((HeKLEN(entry) ? HeKEY(entry) : ""),
1121 hv_iterval(HV *hv, register HE *entry)
1123 if (SvRMAGICAL(hv)) {
1124 if (mg_find((SV*)hv,'P')) {
1125 SV* sv = sv_newmortal();
1126 if (HeKLEN(entry) == HEf_SVKEY)
1127 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1128 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1132 return HeVAL(entry);
1136 hv_iternextsv(HV *hv, char **key, I32 *retlen)
1139 if ( (he = hv_iternext(hv)) == NULL)
1141 *key = hv_iterkey(he, retlen);
1142 return hv_iterval(hv, he);
1146 hv_magic(HV *hv, GV *gv, int how)
1148 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1152 sharepvn(const char *sv, I32 len, U32 hash)
1154 return HEK_KEY(share_hek(sv, len, hash));
1157 /* possibly free a shared string if no one has access to it
1158 * len and hash must both be valid for str.
1161 unsharepvn(const char *str, I32 len, U32 hash)
1163 register XPVHV* xhv;
1165 register HE **oentry;
1169 /* what follows is the moral equivalent of:
1170 if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
1171 if (--*Svp == Nullsv)
1172 hv_delete(PL_strtab, str, len, G_DISCARD, hash);
1174 xhv = (XPVHV*)SvANY(PL_strtab);
1175 /* assert(xhv_array != 0) */
1177 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1178 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1179 if (HeHASH(entry) != hash) /* strings can't be equal */
1181 if (HeKLEN(entry) != len)
1183 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1186 if (--HeVAL(entry) == Nullsv) {
1187 *oentry = HeNEXT(entry);
1190 Safefree(HeKEY_hek(entry));
1196 UNLOCK_STRTAB_MUTEX;
1199 warn("Attempt to free non-existent shared string");
1202 /* get a (constant) string ptr from the global string table
1203 * string will get added if it is not already there.
1204 * len and hash must both be valid for str.
1207 share_hek(const char *str, I32 len, register U32 hash)
1209 register XPVHV* xhv;
1211 register HE **oentry;
1215 /* what follows is the moral equivalent of:
1217 if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
1218 hv_store(PL_strtab, str, len, Nullsv, hash);
1220 xhv = (XPVHV*)SvANY(PL_strtab);
1221 /* assert(xhv_array != 0) */
1223 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1224 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1225 if (HeHASH(entry) != hash) /* strings can't be equal */
1227 if (HeKLEN(entry) != len)
1229 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1236 HeKEY_hek(entry) = save_hek(str, len, hash);
1237 HeVAL(entry) = Nullsv;
1238 HeNEXT(entry) = *oentry;
1241 if (i) { /* initial entry? */
1243 if (xhv->xhv_keys > xhv->xhv_max)
1248 ++HeVAL(entry); /* use value slot as REFCNT */
1249 UNLOCK_STRTAB_MUTEX;
1250 return HeKEY_hek(entry);