3 * Copyright (c) 1991-1997, 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 HE* more_he _((void));
24 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
25 # define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) )
27 # define MALLOC_OVERHEAD 16
28 # define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
37 PL_he_root = HeNEXT(he);
46 HeNEXT(p) = (HE*)PL_he_root;
55 New(54, PL_he_root, 1008/sizeof(HE), HE);
57 heend = &he[1008 / sizeof(HE) - 1];
59 HeNEXT(he) = (HE*)(he + 1);
67 save_hek(char *str, I32 len, U32 hash)
72 New(54, k, HEK_BASESIZE + len + 1, char);
74 Copy(str, HEK_KEY(hek), len, char);
75 *(HEK_KEY(hek) + len) = '\0';
84 unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
87 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
91 hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
101 if (SvRMAGICAL(hv)) {
102 if (mg_find((SV*)hv,'P')) {
105 mg_copy((SV*)hv, sv, key, klen);
107 return &PL_hv_fetch_sv;
109 #ifdef ENV_IS_CASELESS
110 else if (mg_find((SV*)hv,'E')) {
112 for (i = 0; i < klen; ++i)
113 if (isLOWER(key[i])) {
114 char *nkey = strupr(SvPVX(sv_2mortal(newSVpv(key,klen))));
115 SV **ret = hv_fetch(hv, nkey, klen, 0);
117 ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
124 xhv = (XPVHV*)SvANY(hv);
125 if (!xhv->xhv_array) {
127 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
128 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
131 Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
136 PERL_HASH(hash, key, klen);
138 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
139 for (; entry; entry = HeNEXT(entry)) {
140 if (HeHASH(entry) != hash) /* strings can't be equal */
142 if (HeKLEN(entry) != klen)
144 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
146 return &HeVAL(entry);
148 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
149 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
152 if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
153 sv = newSVpv(gotenv,strlen(gotenv));
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(newSVpv(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)) {
243 if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
244 sv = newSVpv(gotenv,strlen(gotenv));
246 return hv_store_ent(hv,keysv,sv,hash);
250 if (lval) { /* gonna assign to this, so it better be there */
252 return hv_store_ent(hv,keysv,sv,hash);
258 hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store)
260 MAGIC *mg = SvMAGIC(hv);
264 if (isUPPER(mg->mg_type)) {
266 switch (mg->mg_type) {
269 *needs_store = FALSE;
272 mg = mg->mg_moremagic;
277 hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
282 register HE **oentry;
287 xhv = (XPVHV*)SvANY(hv);
291 hv_magic_check (hv, &needs_copy, &needs_store);
293 mg_copy((SV*)hv, val, key, klen);
294 if (!xhv->xhv_array && !needs_store)
296 #ifdef ENV_IS_CASELESS
297 else if (mg_find((SV*)hv,'E')) {
298 SV *sv = sv_2mortal(newSVpv(key,klen));
299 key = strupr(SvPVX(sv));
306 PERL_HASH(hash, key, klen);
309 Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
311 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
314 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
315 if (HeHASH(entry) != hash) /* strings can't be equal */
317 if (HeKLEN(entry) != klen)
319 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
321 SvREFCNT_dec(HeVAL(entry));
323 return &HeVAL(entry);
328 HeKEY_hek(entry) = share_hek(key, klen, hash);
329 else /* gotta do the real thing */
330 HeKEY_hek(entry) = save_hek(key, klen, hash);
332 HeNEXT(entry) = *oentry;
336 if (i) { /* initial entry? */
338 if (xhv->xhv_keys > xhv->xhv_max)
342 return &HeVAL(entry);
346 hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
353 register HE **oentry;
358 xhv = (XPVHV*)SvANY(hv);
363 hv_magic_check (hv, &needs_copy, &needs_store);
365 bool save_taint = PL_tainted;
367 PL_tainted = SvTAINTED(keysv);
368 keysv = sv_2mortal(newSVsv(keysv));
369 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
370 TAINT_IF(save_taint);
371 if (!xhv->xhv_array && !needs_store)
373 #ifdef ENV_IS_CASELESS
374 else if (mg_find((SV*)hv,'E')) {
375 key = SvPV(keysv, klen);
376 keysv = sv_2mortal(newSVpv(key,klen));
377 (void)strupr(SvPVX(keysv));
384 key = SvPV(keysv, klen);
387 PERL_HASH(hash, key, klen);
390 Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
392 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
395 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
396 if (HeHASH(entry) != hash) /* strings can't be equal */
398 if (HeKLEN(entry) != klen)
400 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
402 SvREFCNT_dec(HeVAL(entry));
409 HeKEY_hek(entry) = share_hek(key, klen, hash);
410 else /* gotta do the real thing */
411 HeKEY_hek(entry) = save_hek(key, klen, hash);
413 HeNEXT(entry) = *oentry;
417 if (i) { /* initial entry? */
419 if (xhv->xhv_keys > xhv->xhv_max)
427 hv_delete(HV *hv, char *key, U32 klen, I32 flags)
433 register HE **oentry;
439 if (SvRMAGICAL(hv)) {
442 hv_magic_check (hv, &needs_copy, &needs_store);
444 if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
448 if (mg_find(sv, 'p')) {
449 sv_unmagic(sv, 'p'); /* No longer an element */
452 return Nullsv; /* element cannot be deleted */
454 #ifdef ENV_IS_CASELESS
455 else if (mg_find((SV*)hv,'E')) {
456 sv = sv_2mortal(newSVpv(key,klen));
457 key = strupr(SvPVX(sv));
462 xhv = (XPVHV*)SvANY(hv);
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)
488 hv_free_ent(hv, entry);
496 hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
503 register HE **oentry;
508 if (SvRMAGICAL(hv)) {
511 hv_magic_check (hv, &needs_copy, &needs_store);
513 if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
517 if (mg_find(sv, 'p')) {
518 sv_unmagic(sv, 'p'); /* No longer an element */
521 return Nullsv; /* element cannot be deleted */
523 #ifdef ENV_IS_CASELESS
524 else if (mg_find((SV*)hv,'E')) {
525 key = SvPV(keysv, klen);
526 keysv = sv_2mortal(newSVpv(key,klen));
527 (void)strupr(SvPVX(keysv));
533 xhv = (XPVHV*)SvANY(hv);
537 key = SvPV(keysv, klen);
540 PERL_HASH(hash, key, klen);
542 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
545 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
546 if (HeHASH(entry) != hash) /* strings can't be equal */
548 if (HeKLEN(entry) != klen)
550 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
552 *oentry = HeNEXT(entry);
555 if (flags & G_DISCARD)
558 sv = sv_mortalcopy(HeVAL(entry));
559 if (entry == xhv->xhv_eiter)
562 hv_free_ent(hv, entry);
570 hv_exists(HV *hv, char *key, U32 klen)
580 if (SvRMAGICAL(hv)) {
581 if (mg_find((SV*)hv,'P')) {
584 mg_copy((SV*)hv, sv, key, klen);
585 magic_existspack(sv, mg_find(sv, 'p'));
588 #ifdef ENV_IS_CASELESS
589 else if (mg_find((SV*)hv,'E')) {
590 sv = sv_2mortal(newSVpv(key,klen));
591 key = strupr(SvPVX(sv));
596 xhv = (XPVHV*)SvANY(hv);
600 PERL_HASH(hash, key, klen);
602 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
603 for (; entry; entry = HeNEXT(entry)) {
604 if (HeHASH(entry) != hash) /* strings can't be equal */
606 if (HeKLEN(entry) != klen)
608 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
617 hv_exists_ent(HV *hv, SV *keysv, U32 hash)
628 if (SvRMAGICAL(hv)) {
629 if (mg_find((SV*)hv,'P')) {
630 dTHR; /* just for SvTRUE */
632 keysv = sv_2mortal(newSVsv(keysv));
633 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
634 magic_existspack(sv, mg_find(sv, 'p'));
637 #ifdef ENV_IS_CASELESS
638 else if (mg_find((SV*)hv,'E')) {
639 key = SvPV(keysv, klen);
640 keysv = sv_2mortal(newSVpv(key,klen));
641 (void)strupr(SvPVX(keysv));
647 xhv = (XPVHV*)SvANY(hv);
651 key = SvPV(keysv, klen);
653 PERL_HASH(hash, key, klen);
655 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
656 for (; entry; entry = HeNEXT(entry)) {
657 if (HeHASH(entry) != hash) /* strings can't be equal */
659 if (HeKLEN(entry) != klen)
661 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
671 register XPVHV* xhv = (XPVHV*)SvANY(hv);
672 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
673 register I32 newsize = oldsize * 2;
675 register char *a = xhv->xhv_array;
679 register HE **oentry;
682 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
683 Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
689 #define MALLOC_OVERHEAD 16
690 New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
695 Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
697 offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
700 Safefree(xhv->xhv_array);
704 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
705 xhv->xhv_max = --newsize;
709 for (i=0; i<oldsize; i++,aep++) {
710 if (!*aep) /* non-existent */
713 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
714 if ((HeHASH(entry) & newsize) != i) {
715 *oentry = HeNEXT(entry);
716 HeNEXT(entry) = *bep;
723 oentry = &HeNEXT(entry);
725 if (!*aep) /* everything moved */
731 hv_ksplit(HV *hv, IV newmax)
733 register XPVHV* xhv = (XPVHV*)SvANY(hv);
734 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
735 register I32 newsize;
741 register HE **oentry;
743 newsize = (I32) newmax; /* possible truncation here */
744 if (newsize != newmax || newmax <= oldsize)
746 while ((newsize & (1 + ~newsize)) != newsize) {
747 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
749 if (newsize < newmax)
751 if (newsize < newmax)
752 return; /* overflow detection */
757 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
758 Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
764 New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
769 Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
771 offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
774 Safefree(xhv->xhv_array);
777 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
780 Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char);
782 xhv->xhv_max = --newsize;
784 if (!xhv->xhv_fill) /* skip rest if no entries */
788 for (i=0; i<oldsize; i++,aep++) {
789 if (!*aep) /* non-existent */
791 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
792 if ((j = (HeHASH(entry) & newsize)) != i) {
794 *oentry = HeNEXT(entry);
795 if (!(HeNEXT(entry) = aep[j]))
801 oentry = &HeNEXT(entry);
803 if (!*aep) /* everything moved */
814 hv = (HV*)NEWSV(502,0);
815 sv_upgrade((SV *)hv, SVt_PVHV);
816 xhv = (XPVHV*)SvANY(hv);
819 #ifndef NODEFAULT_SHAREKEYS
820 HvSHAREKEYS_on(hv); /* key-sharing on by default */
822 xhv->xhv_max = 7; /* start with 8 buckets */
825 (void)hv_iterinit(hv); /* so each() will start off right */
834 STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
835 STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
838 while (hv_max && hv_max + 1 >= hv_fill * 2)
839 hv_max = hv_max / 2; /* Is always 2^n-1 */
840 ((XPVHV*)SvANY(hv))->xhv_max = hv_max;
845 if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) {
852 I32 hv_riter = HvRITER(ohv); /* current root of iterator */
853 HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
857 while (entry = hv_iternext(ohv)) {
858 hv_store(hv, HeKEY(entry), HeKLEN(entry),
859 SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
861 HvRITER(ohv) = hv_riter;
862 HvEITER(ohv) = hv_eiter;
869 hv_free_ent(HV *hv, register HE *entry)
876 if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
877 PL_sub_generation++; /* may be deletion of method from stash */
879 if (HeKLEN(entry) == HEf_SVKEY) {
880 SvREFCNT_dec(HeKEY_sv(entry));
881 Safefree(HeKEY_hek(entry));
883 else if (HvSHAREKEYS(hv))
884 unshare_hek(HeKEY_hek(entry));
886 Safefree(HeKEY_hek(entry));
891 hv_delayfree_ent(HV *hv, register HE *entry)
895 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
896 PL_sub_generation++; /* may be deletion of method from stash */
897 sv_2mortal(HeVAL(entry)); /* free between statements */
898 if (HeKLEN(entry) == HEf_SVKEY) {
899 sv_2mortal(HeKEY_sv(entry));
900 Safefree(HeKEY_hek(entry));
902 else if (HvSHAREKEYS(hv))
903 unshare_hek(HeKEY_hek(entry));
905 Safefree(HeKEY_hek(entry));
915 xhv = (XPVHV*)SvANY(hv);
920 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
931 register HE *oentry = Null(HE*);
947 entry = HeNEXT(entry);
948 hv_free_ent(hv, oentry);
953 entry = array[riter];
956 (void)hv_iterinit(hv);
965 xhv = (XPVHV*)SvANY(hv);
967 Safefree(xhv->xhv_array);
969 Safefree(HvNAME(hv));
973 xhv->xhv_max = 7; /* it's a normal hash */
989 xhv = (XPVHV*)SvANY(hv);
990 entry = xhv->xhv_eiter;
991 #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
992 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
995 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
997 hv_free_ent(hv, entry);
1000 xhv->xhv_eiter = Null(HE*);
1001 return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */
1007 register XPVHV* xhv;
1014 xhv = (XPVHV*)SvANY(hv);
1015 oldentry = entry = xhv->xhv_eiter;
1017 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
1018 SV *key = sv_newmortal();
1020 sv_setsv(key, HeSVKEY_force(entry));
1021 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
1027 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
1029 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
1031 HeKEY_hek(entry) = hek;
1032 HeKLEN(entry) = HEf_SVKEY;
1034 magic_nextpack((SV*) hv,mg,key);
1036 /* force key to stay around until next time */
1037 HeSVKEY_set(entry, SvREFCNT_inc(key));
1038 return entry; /* beware, hent_val is not set */
1041 SvREFCNT_dec(HeVAL(entry));
1042 Safefree(HeKEY_hek(entry));
1044 xhv->xhv_eiter = Null(HE*);
1048 if (!xhv->xhv_array)
1049 Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
1051 entry = HeNEXT(entry);
1054 if (xhv->xhv_riter > xhv->xhv_max) {
1055 xhv->xhv_riter = -1;
1058 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1061 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
1063 hv_free_ent(hv, oldentry);
1066 xhv->xhv_eiter = entry;
1071 hv_iterkey(register HE *entry, I32 *retlen)
1073 if (HeKLEN(entry) == HEf_SVKEY) {
1075 char *p = SvPV(HeKEY_sv(entry), len);
1080 *retlen = HeKLEN(entry);
1081 return HeKEY(entry);
1085 /* unlike hv_iterval(), this always returns a mortal copy of the key */
1087 hv_iterkeysv(register HE *entry)
1089 if (HeKLEN(entry) == HEf_SVKEY)
1090 return sv_mortalcopy(HeKEY_sv(entry));
1092 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
1097 hv_iterval(HV *hv, register HE *entry)
1099 if (SvRMAGICAL(hv)) {
1100 if (mg_find((SV*)hv,'P')) {
1101 SV* sv = sv_newmortal();
1102 if (HeKLEN(entry) == HEf_SVKEY)
1103 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1104 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1108 return HeVAL(entry);
1112 hv_iternextsv(HV *hv, char **key, I32 *retlen)
1115 if ( (he = hv_iternext(hv)) == NULL)
1117 *key = hv_iterkey(he, retlen);
1118 return hv_iterval(hv, he);
1122 hv_magic(HV *hv, GV *gv, int how)
1124 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1128 sharepvn(char *sv, I32 len, U32 hash)
1130 return HEK_KEY(share_hek(sv, len, hash));
1133 /* possibly free a shared string if no one has access to it
1134 * len and hash must both be valid for str.
1137 unsharepvn(char *str, I32 len, U32 hash)
1139 register XPVHV* xhv;
1141 register HE **oentry;
1145 /* what follows is the moral equivalent of:
1146 if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
1147 if (--*Svp == Nullsv)
1148 hv_delete(PL_strtab, str, len, G_DISCARD, hash);
1150 xhv = (XPVHV*)SvANY(PL_strtab);
1151 /* assert(xhv_array != 0) */
1152 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1153 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1154 if (HeHASH(entry) != hash) /* strings can't be equal */
1156 if (HeKLEN(entry) != len)
1158 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1161 if (--HeVAL(entry) == Nullsv) {
1162 *oentry = HeNEXT(entry);
1165 Safefree(HeKEY_hek(entry));
1173 warn("Attempt to free non-existent shared string");
1176 /* get a (constant) string ptr from the global string table
1177 * string will get added if it is not already there.
1178 * len and hash must both be valid for str.
1181 share_hek(char *str, I32 len, register U32 hash)
1183 register XPVHV* xhv;
1185 register HE **oentry;
1189 /* what follows is the moral equivalent of:
1191 if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
1192 hv_store(PL_strtab, str, len, Nullsv, hash);
1194 xhv = (XPVHV*)SvANY(PL_strtab);
1195 /* assert(xhv_array != 0) */
1196 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1197 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1198 if (HeHASH(entry) != hash) /* strings can't be equal */
1200 if (HeKLEN(entry) != len)
1202 if (memNE(HeKEY(entry),str,len)) /* is this it? */
1209 HeKEY_hek(entry) = save_hek(str, len, hash);
1210 HeVAL(entry) = Nullsv;
1211 HeNEXT(entry) = *oentry;
1214 if (i) { /* initial entry? */
1216 if (xhv->xhv_keys > xhv->xhv_max)
1221 ++HeVAL(entry); /* use value slot as REFCNT */
1222 return HeKEY_hek(entry);