X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8990e3071044a96302560bbdb5706f3e74cf1bef..a60067777be62ee91d1318f9ae26d9ed713245de:/hv.c diff --git a/hv.c b/hv.c index 2468e87..3208b56 100644 --- a/hv.c +++ b/hv.c @@ -1,35 +1,87 @@ -/* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $ +/* hv.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: hash.c,v $ - * Revision 4.1 92/08/07 18:21:48 lwall - * - * Revision 4.0.1.3 92/06/08 13:26:29 lwall - * patch20: removed implicit int declarations on functions - * patch20: delete could cause %array to give too low a count of buckets filled - * patch20: hash tables now split only if the memory is available to do so - * - * Revision 4.0.1.2 91/11/05 17:24:13 lwall - * patch11: saberized perl - * - * Revision 4.0.1.1 91/06/07 11:10:11 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:22:26 lwall - * 4.0 baseline. - * + */ + +/* + * "I sit beside the fire and think of all that I have seen." --Bilbo */ #include "EXTERN.h" #include "perl.h" -static void hsplit(); +static void hsplit _((HV *hv)); +static void hfreeentries _((HV *hv)); + +static HE* more_he(); + +static HE* +new_he() +{ + HE* he; + if (he_root) { + he = he_root; + he_root = HeNEXT(he); + return he; + } + return more_he(); +} + +static void +del_he(p) +HE* p; +{ + HeNEXT(p) = (HE*)he_root; + he_root = p; +} + +static HE* +more_he() +{ + register HE* he; + register HE* heend; + he_root = (HE*)safemalloc(1008); + he = he_root; + heend = &he[1008 / sizeof(HE) - 1]; + while (he < heend) { + HeNEXT(he) = (HE*)(he + 1); + he++; + } + HeNEXT(he) = 0; + return new_he(); +} + +static HEK * +save_hek(str, len, hash) +char *str; +I32 len; +U32 hash; +{ + char *k; + register HEK *hek; + + New(54, k, HEK_BASESIZE + len + 1, char); + hek = (HEK*)k; + Copy(str, HEK_KEY(hek), len, char); + *(HEK_KEY(hek) + len) = '\0'; + HEK_LEN(hek) = len; + HEK_HASH(hek) = hash; + return hek; +} + +void +unshare_hek(hek) +HEK *hek; +{ + unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek)); +} -static void hfreeentries(); +/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot + * contains an SV* */ SV** hv_fetch(hv,key,klen,lval) @@ -39,9 +91,7 @@ U32 klen; I32 lval; { register XPVHV* xhv; - register char *s; - register I32 i; - register I32 hash; + register U32 hash; register HE *entry; SV *sv; @@ -52,10 +102,6 @@ I32 lval; if (mg_find((SV*)hv,'P')) { sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); - if (!lval) { - mg_get(sv); - sv_unmagic(sv,'p'); - } Sv = sv; return &Sv; } @@ -63,28 +109,39 @@ I32 lval; xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) { - if (lval) + if (lval +#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ + || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) +#endif + ) Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); else return 0; } - i = klen; - hash = 0; - s = key; - while (i--) - hash = hash * 33 + *s++; + PERL_HASH(hash, key, klen); - entry = ((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; - for (; entry; entry = entry->hent_next) { - if (entry->hent_hash != hash) /* strings can't be equal */ + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (entry->hent_klen != klen) + if (HeKLEN(entry) != klen) continue; - if (bcmp(entry->hent_key,key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; - return &entry->hent_val; + return &HeVAL(entry); } +#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ + if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { + char *gotenv; + + gotenv = my_getenv(key); + if (gotenv != NULL) { + sv = newSVpv(gotenv,strlen(gotenv)); + return hv_store(hv,key,klen,sv,hash); + } + } +#endif if (lval) { /* gonna assign to this, so it better be there */ sv = NEWSV(61,0); return hv_store(hv,key,klen,sv,hash); @@ -92,6 +149,86 @@ I32 lval; return 0; } +/* returns a HE * structure with the all fields set */ +/* note that hent_val will be a mortal sv for MAGICAL hashes */ +HE * +hv_fetch_ent(hv,keysv,lval,hash) +HV *hv; +SV *keysv; +I32 lval; +register U32 hash; +{ + register XPVHV* xhv; + register char *key; + STRLEN klen; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) { + static HE mh; + + sv = sv_newmortal(); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); + if (!HeKEY_hek(&mh)) { + char *k; + New(54, k, HEK_BASESIZE + sizeof(SV*), char); + HeKEY_hek(&mh) = (HEK*)k; + HeKLEN(&mh) = HEf_SVKEY; /* key will always hold an SV* */ + } + HeSVKEY_set(&mh, keysv); + HeVAL(&mh) = sv; + return &mh; + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) { + if (lval +#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ + || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) +#endif + ) + Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); + else + return 0; + } + + key = SvPV(keysv, klen); + + if (!hash) + PERL_HASH(hash, key, klen); + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + return entry; + } +#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ + if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { + char *gotenv; + + gotenv = my_getenv(key); + if (gotenv != NULL) { + sv = newSVpv(gotenv,strlen(gotenv)); + return hv_store_ent(hv,keysv,sv,hash); + } + } +#endif + if (lval) { /* gonna assign to this, so it better be there */ + sv = NEWSV(61,0); + return hv_store_ent(hv,keysv,sv,hash); + } + return 0; +} + SV** hv_store(hv,key,klen,val,hash) HV *hv; @@ -101,7 +238,6 @@ SV *val; register U32 hash; { register XPVHV* xhv; - register char *s; register I32 i; register HE *entry; register HE **oentry; @@ -112,40 +248,116 @@ register U32 hash; xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { mg_copy((SV*)hv, val, key, klen); - if (!xhv->xhv_array) + if (!xhv->xhv_array + && (SvMAGIC(hv)->mg_moremagic + || (SvMAGIC(hv)->mg_type != 'E' +#ifdef OVERLOAD + && SvMAGIC(hv)->mg_type != 'A' +#endif /* OVERLOAD */ + ))) return 0; } - if (!hash) { - i = klen; - s = key; - while (i--) - hash = hash * 33 + *s++; + if (!hash) + PERL_HASH(hash, key, klen); + + if (!xhv->xhv_array) + Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); + + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + i = 1; + + for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + SvREFCNT_dec(HeVAL(entry)); + HeVAL(entry) = val; + return &HeVAL(entry); + } + + entry = new_he(); + if (HvSHAREKEYS(hv)) + HeKEY_hek(entry) = share_hek(key, klen, hash); + else /* gotta do the real thing */ + HeKEY_hek(entry) = save_hek(key, klen, hash); + HeVAL(entry) = val; + HeNEXT(entry) = *oentry; + *oentry = entry; + + xhv->xhv_keys++; + if (i) { /* initial entry? */ + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) + hsplit(hv); + } + + return &HeVAL(entry); +} + +HE * +hv_store_ent(hv,keysv,val,hash) +HV *hv; +SV *keysv; +SV *val; +register U32 hash; +{ + register XPVHV* xhv; + register char *key; + STRLEN klen; + register I32 i; + register HE *entry; + register HE **oentry; + + if (!hv) + return 0; + + xhv = (XPVHV*)SvANY(hv); + if (SvMAGICAL(hv)) { + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); + if (!xhv->xhv_array + && (SvMAGIC(hv)->mg_moremagic + || (SvMAGIC(hv)->mg_type != 'E' +#ifdef OVERLOAD + && SvMAGIC(hv)->mg_type != 'A' +#endif /* OVERLOAD */ + ))) + return Nullhe; } + key = SvPV(keysv, klen); + + if (!hash) + PERL_HASH(hash, key, klen); + if (!xhv->xhv_array) Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); - oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; - for (entry = *oentry; entry; i=0, entry = entry->hent_next) { - if (entry->hent_hash != hash) /* strings can't be equal */ + for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (entry->hent_klen != klen) + if (HeKLEN(entry) != klen) continue; - if (bcmp(entry->hent_key,key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; - SvREFCNT_dec(entry->hent_val); - entry->hent_val = val; - return &entry->hent_val; + SvREFCNT_dec(HeVAL(entry)); + HeVAL(entry) = val; + return entry; } - New(501,entry, 1, HE); - entry->hent_klen = klen; - entry->hent_key = nsavestr(key,klen); - entry->hent_val = val; - entry->hent_hash = hash; - entry->hent_next = *oentry; + entry = new_he(); + if (HvSHAREKEYS(hv)) + HeKEY_hek(entry) = share_hek(key, klen, hash); + else /* gotta do the real thing */ + HeKEY_hek(entry) = save_hek(key, klen, hash); + HeVAL(entry) = val; + HeNEXT(entry) = *oentry; *oentry = entry; xhv->xhv_keys++; @@ -155,19 +367,19 @@ register U32 hash; hsplit(hv); } - return &entry->hent_val; + return entry; } SV * -hv_delete(hv,key,klen) +hv_delete(hv,key,klen,flags) HV *hv; char *key; U32 klen; +I32 flags; { register XPVHV* xhv; - register char *s; register I32 i; - register I32 hash; + register U32 hash; register HE *entry; register HE **oentry; SV *sv; @@ -177,53 +389,237 @@ U32 klen; if (SvRMAGICAL(hv)) { sv = *hv_fetch(hv, key, klen, TRUE); mg_clear(sv); + if (mg_find(sv, 's')) { + return Nullsv; /* %SIG elements cannot be deleted */ + } + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } + } + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return Nullsv; + + PERL_HASH(hash, key, klen); + + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + entry = *oentry; + i = 1; + for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + *oentry = HeNEXT(entry); + if (i && !*oentry) + xhv->xhv_fill--; + if (flags & G_DISCARD) + sv = Nullsv; + else + sv = sv_mortalcopy(HeVAL(entry)); + if (entry == xhv->xhv_eiter) + HvLAZYDEL_on(hv); + else + he_free(entry, HvSHAREKEYS(hv)); + --xhv->xhv_keys; + return sv; + } + return Nullsv; +} + +SV * +hv_delete_ent(hv,keysv,flags,hash) +HV *hv; +SV *keysv; +I32 flags; +U32 hash; +{ + register XPVHV* xhv; + register I32 i; + register char *key; + STRLEN klen; + register HE *entry; + register HE **oentry; + SV *sv; + + if (!hv) + return Nullsv; + if (SvRMAGICAL(hv)) { + entry = hv_fetch_ent(hv, keysv, TRUE, hash); + sv = HeVAL(entry); + mg_clear(sv); + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } } xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) return Nullsv; - i = klen; - hash = 0; - s = key; - while (i--) - hash = hash * 33 + *s++; - oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; + key = SvPV(keysv, klen); + + if (!hash) + PERL_HASH(hash, key, klen); + + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; entry = *oentry; i = 1; - for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) { - if (entry->hent_hash != hash) /* strings can't be equal */ + for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { + if (HeHASH(entry) != hash) /* strings can't be equal */ continue; - if (entry->hent_klen != klen) + if (HeKLEN(entry) != klen) continue; - if (bcmp(entry->hent_key,key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; - *oentry = entry->hent_next; + *oentry = HeNEXT(entry); if (i && !*oentry) xhv->xhv_fill--; - sv = sv_mortalcopy(entry->hent_val); - he_free(entry); + if (flags & G_DISCARD) + sv = Nullsv; + else + sv = sv_mortalcopy(HeVAL(entry)); + if (entry == xhv->xhv_eiter) + HvLAZYDEL_on(hv); + else + he_free(entry, HvSHAREKEYS(hv)); --xhv->xhv_keys; return sv; } return Nullsv; } +bool +hv_exists(hv,key,klen) +HV *hv; +char *key; +U32 klen; +{ + register XPVHV* xhv; + register U32 hash; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + sv = sv_newmortal(); + mg_copy((SV*)hv, sv, key, klen); + magic_existspack(sv, mg_find(sv, 'p')); + return SvTRUE(sv); + } + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return 0; + + PERL_HASH(hash, key, klen); + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + return TRUE; + } + return FALSE; +} + + +bool +hv_exists_ent(hv,keysv,hash) +HV *hv; +SV *keysv; +U32 hash; +{ + register XPVHV* xhv; + register char *key; + STRLEN klen; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + sv = sv_newmortal(); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); + magic_existspack(sv, mg_find(sv, 'p')); + return SvTRUE(sv); + } + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return 0; + + key = SvPV(keysv, klen); + if (!hash) + PERL_HASH(hash, key, klen); + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + return TRUE; + } + return FALSE; +} + static void hsplit(hv) HV *hv; { register XPVHV* xhv = (XPVHV*)SvANY(hv); - I32 oldsize = xhv->xhv_max + 1; + I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ register I32 newsize = oldsize * 2; register I32 i; register HE **a; register HE **b; register HE *entry; register HE **oentry; +#ifndef STRANGE_MALLOC + I32 tmp; +#endif a = (HE**)xhv->xhv_array; nomemok = TRUE; +#ifdef STRANGE_MALLOC Renew(a, newsize, HE*); +#else + i = newsize * sizeof(HE*); +#define MALLOC_OVERHEAD 16 + tmp = MALLOC_OVERHEAD; + while (tmp - MALLOC_OVERHEAD < i) + tmp += tmp; + tmp -= MALLOC_OVERHEAD; + tmp /= sizeof(HE*); + assert(tmp >= newsize); + New(2,a, tmp, HE*); + Copy(xhv->xhv_array, a, oldsize, HE*); + if (oldsize >= 64 && !nice_chunk) { + nice_chunk = (char*)xhv->xhv_array; + nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; + } + else + Safefree(xhv->xhv_array); +#endif + nomemok = FALSE; Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/ xhv->xhv_max = --newsize; @@ -234,16 +630,94 @@ HV *hv; continue; b = a+oldsize; for (oentry = a, entry = *a; entry; entry = *oentry) { - if ((entry->hent_hash & newsize) != i) { - *oentry = entry->hent_next; - entry->hent_next = *b; + if ((HeHASH(entry) & newsize) != i) { + *oentry = HeNEXT(entry); + HeNEXT(entry) = *b; if (!*b) xhv->xhv_fill++; *b = entry; continue; } else - oentry = &entry->hent_next; + oentry = &HeNEXT(entry); + } + if (!*a) /* everything moved */ + xhv->xhv_fill--; + } +} + +void +hv_ksplit(hv, newmax) +HV *hv; +IV newmax; +{ + register XPVHV* xhv = (XPVHV*)SvANY(hv); + I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ + register I32 newsize; + register I32 i; + register I32 j; + register HE **a; + register HE *entry; + register HE **oentry; + + newsize = (I32) newmax; /* possible truncation here */ + if (newsize != newmax || newmax <= oldsize) + return; + while ((newsize & (1 + ~newsize)) != newsize) { + newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */ + } + if (newsize < newmax) + newsize *= 2; + if (newsize < newmax) + return; /* overflow detection */ + + a = (HE**)xhv->xhv_array; + if (a) { + nomemok = TRUE; +#ifdef STRANGE_MALLOC + Renew(a, newsize, HE*); +#else + i = newsize * sizeof(HE*); + j = MALLOC_OVERHEAD; + while (j - MALLOC_OVERHEAD < i) + j += j; + j -= MALLOC_OVERHEAD; + j /= sizeof(HE*); + assert(j >= newsize); + New(2, a, j, HE*); + Copy(xhv->xhv_array, a, oldsize, HE*); + if (oldsize >= 64 && !nice_chunk) { + nice_chunk = (char*)xhv->xhv_array; + nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; + } + else + Safefree(xhv->xhv_array); +#endif + nomemok = FALSE; + Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/ + } + else { + Newz(0, a, newsize, HE*); + } + xhv->xhv_max = --newsize; + xhv->xhv_array = (char*)a; + if (!xhv->xhv_fill) /* skip rest if no entries */ + return; + + for (i=0; ixhv_fill++; + a[j] = entry; + continue; + } + else + oentry = &HeNEXT(entry); } if (!*a) /* everything moved */ xhv->xhv_fill--; @@ -256,12 +730,14 @@ newHV() register HV *hv; register XPVHV* xhv; - Newz(502,hv, 1, HV); - SvREFCNT(hv) = 1; - sv_upgrade(hv, SVt_PVHV); + hv = (HV*)NEWSV(502,0); + sv_upgrade((SV *)hv, SVt_PVHV); xhv = (XPVHV*)SvANY(hv); SvPOK_off(hv); SvNOK_off(hv); +#ifndef NODEFAULT_SHAREKEYS + HvSHAREKEYS_on(hv); /* key-sharing on by default */ +#endif xhv->xhv_max = 7; /* start with 8 buckets */ xhv->xhv_fill = 0; xhv->xhv_pmroot = 0; @@ -270,25 +746,41 @@ newHV() } void -he_free(hent) +he_free(hent, shared) register HE *hent; +I32 shared; { if (!hent) return; - SvREFCNT_dec(hent->hent_val); - Safefree(hent->hent_key); - Safefree(hent); + if (SvTYPE(HeVAL(hent)) == SVt_PVGV && GvCV(HeVAL(hent))) + sub_generation++; /* May be deletion of method? */ + SvREFCNT_dec(HeVAL(hent)); + if (HeKLEN(hent) == HEf_SVKEY) { + SvREFCNT_dec(HeKEY_sv(hent)); + Safefree(HeKEY_hek(hent)); + } else if (shared) + unshare_hek(HeKEY_hek(hent)); + else + Safefree(HeKEY_hek(hent)); + del_he(hent); } void -he_delayfree(hent) +he_delayfree(hent, shared) register HE *hent; +I32 shared; { if (!hent) return; - sv_2mortal(hent->hent_val); /* free between statements */ - Safefree(hent->hent_key); - Safefree(hent); + sv_2mortal(HeVAL(hent)); /* free between statements */ + if (HeKLEN(hent) == HEf_SVKEY) { + sv_2mortal(HeKEY_sv(hent)); + Safefree(HeKEY_hek(hent)); + } else if (shared) + unshare_hek(HeKEY_hek(hent)); + else + Safefree(HeKEY_hek(hent)); + del_he(hent); } void @@ -301,32 +793,48 @@ HV *hv; xhv = (XPVHV*)SvANY(hv); hfreeentries(hv); xhv->xhv_fill = 0; + xhv->xhv_keys = 0; if (xhv->xhv_array) (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); + + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); } static void hfreeentries(hv) HV *hv; { - register XPVHV* xhv; + register HE **array; register HE *hent; register HE *ohent = Null(HE*); + I32 riter; + I32 max; + I32 shared; if (!hv) return; - xhv = (XPVHV*)SvANY(hv); - if (!xhv->xhv_array) + if (!HvARRAY(hv)) return; + + riter = 0; + max = HvMAX(hv); + array = HvARRAY(hv); + hent = array[0]; + shared = HvSHAREKEYS(hv); + for (;;) { + if (hent) { + ohent = hent; + hent = HeNEXT(hent); + he_free(ohent, shared); + } + if (!hent) { + if (++riter > max) + break; + hent = array[riter]; + } + } (void)hv_iterinit(hv); - /*SUPPRESS 560*/ - while (hent = hv_iternext(hv)) { /* concise but not very efficient */ - he_free(ohent); - ohent = hent; - } - he_free(ohent); - if (SvMAGIC(hv)) - mg_clear((SV*)hv); } void @@ -339,21 +847,17 @@ HV *hv; xhv = (XPVHV*)SvANY(hv); hfreeentries(hv); Safefree(xhv->xhv_array); + if (HvNAME(hv)) { + Safefree(HvNAME(hv)); + HvNAME(hv) = 0; + } xhv->xhv_array = 0; xhv->xhv_max = 7; /* it's a normal associative array */ xhv->xhv_fill = 0; - (void)hv_iterinit(hv); /* so each() will start off right */ -} + xhv->xhv_keys = 0; -void -hv_free(hv) -register HV *hv; -{ - if (!hv) - return; - hfreeentries(hv); - Safefree(HvARRAY(hv)); - Safefree(hv); + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); } I32 @@ -361,6 +865,14 @@ hv_iterinit(hv) HV *hv; { register XPVHV* xhv = (XPVHV*)SvANY(hv); + HE *entry = xhv->xhv_eiter; +#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */ + if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) prime_env_iter(); +#endif + if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ + HvLAZYDEL_off(hv); + he_free(entry, HvSHAREKEYS(hv)); + } xhv->xhv_riter = -1; xhv->xhv_eiter = Null(HE*); return xhv->xhv_fill; @@ -372,51 +884,62 @@ HV *hv; { register XPVHV* xhv; register HE *entry; + HE *oldentry; MAGIC* mg; if (!hv) croak("Bad associative array"); xhv = (XPVHV*)SvANY(hv); - entry = xhv->xhv_eiter; + oldentry = entry = xhv->xhv_eiter; if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { SV *key = sv_newmortal(); - if (entry) - sv_setpvn(key, entry->hent_key, entry->hent_klen); - else { - Newz(504,entry, 1, HE); - xhv->xhv_eiter = entry; - } - magic_nextpack(hv,mg,key); + if (entry) { + sv_setsv(key, HeSVKEY_force(entry)); + SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ + } + else { + char *k; + HEK *hek; + + xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */ + Zero(entry, 1, HE); + Newz(54, k, HEK_BASESIZE + sizeof(SV*), char); + hek = (HEK*)k; + HeKEY_hek(entry) = hek; + HeKLEN(entry) = HEf_SVKEY; + } + magic_nextpack((SV*) hv,mg,key); if (SvOK(key)) { - STRLEN len; - entry->hent_key = SvPV(key, len); - entry->hent_klen = len; - SvPOK_off(key); - SvPVX(key) = 0; - return entry; + /* force key to stay around until next time */ + HeSVKEY_set(entry, SvREFCNT_inc(key)); + return entry; /* beware, hent_val is not set */ } - if (entry->hent_val) - SvREFCNT_dec(entry->hent_val); - Safefree(entry); + if (HeVAL(entry)) + SvREFCNT_dec(HeVAL(entry)); + Safefree(HeKEY_hek(entry)); + del_he(entry); xhv->xhv_eiter = Null(HE*); return Null(HE*); } if (!xhv->xhv_array) Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); - do { - if (entry) - entry = entry->hent_next; - if (!entry) { - xhv->xhv_riter++; - if (xhv->xhv_riter > xhv->xhv_max) { - xhv->xhv_riter = -1; - break; - } - entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter]; + if (entry) + entry = HeNEXT(entry); + while (!entry) { + ++xhv->xhv_riter; + if (xhv->xhv_riter > xhv->xhv_max) { + xhv->xhv_riter = -1; + break; } - } while (!entry); + entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter]; + } + + if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ + HvLAZYDEL_off(hv); + he_free(oldentry, HvSHAREKEYS(hv)); + } xhv->xhv_eiter = entry; return entry; @@ -427,8 +950,25 @@ hv_iterkey(entry,retlen) register HE *entry; I32 *retlen; { - *retlen = entry->hent_klen; - return entry->hent_key; + if (HeKLEN(entry) == HEf_SVKEY) { + return SvPV(HeKEY_sv(entry), *(STRLEN*)retlen); + } + else { + *retlen = HeKLEN(entry); + return HeKEY(entry); + } +} + +/* unlike hv_iterval(), this always returns a mortal copy of the key */ +SV * +hv_iterkeysv(entry) +register HE *entry; +{ + if (HeKLEN(entry) == HEf_SVKEY) + return sv_mortalcopy(HeKEY_sv(entry)); + else + return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""), + HeKLEN(entry))); } SV * @@ -439,20 +979,142 @@ register HE *entry; if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { SV* sv = sv_newmortal(); - mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen); - mg_get(sv); - sv_unmagic(sv,'p'); + if (HeKLEN(entry) == HEf_SVKEY) + mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY); + else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); return sv; } } - return entry->hent_val; + return HeVAL(entry); +} + +SV * +hv_iternextsv(hv, key, retlen) + HV *hv; + char **key; + I32 *retlen; +{ + HE *he; + if ( (he = hv_iternext(hv)) == NULL) + return NULL; + *key = hv_iterkey(he, retlen); + return hv_iterval(hv, he); } void hv_magic(hv, gv, how) HV* hv; GV* gv; -I32 how; +int how; +{ + sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); +} + +char* +sharepvn(sv, len, hash) +char* sv; +I32 len; +U32 hash; { - sv_magic((SV*)hv, (SV*)gv, how, 0, 0); + return HEK_KEY(share_hek(sv, len, hash)); +} + +/* possibly free a shared string if no one has access to it + * len and hash must both be valid for str. + */ +void +unsharepvn(str, len, hash) +char* str; +I32 len; +U32 hash; +{ + register XPVHV* xhv; + register HE *entry; + register HE **oentry; + register I32 i = 1; + I32 found = 0; + + /* what follows is the moral equivalent of: + if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) { + if (--*Svp == Nullsv) + hv_delete(strtab, str, len, G_DISCARD, hash); + } */ + xhv = (XPVHV*)SvANY(strtab); + /* assert(xhv_array != 0) */ + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != len) + continue; + if (memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + found = 1; + if (--HeVAL(entry) == Nullsv) { + *oentry = HeNEXT(entry); + if (i && !*oentry) + xhv->xhv_fill--; + Safefree(HeKEY_hek(entry)); + del_he(entry); + --xhv->xhv_keys; + } + break; + } + + if (!found) + warn("Attempt to free non-existent shared string"); } + +/* get a (constant) string ptr from the global string table + * string will get added if it is not already there. + * len and hash must both be valid for str. + */ +HEK * +share_hek(str, len, hash) +char *str; +I32 len; +register U32 hash; +{ + register XPVHV* xhv; + register HE *entry; + register HE **oentry; + register I32 i = 1; + I32 found = 0; + + /* what follows is the moral equivalent of: + + if (!(Svp = hv_fetch(strtab, str, len, FALSE))) + hv_store(strtab, str, len, Nullsv, hash); + */ + xhv = (XPVHV*)SvANY(strtab); + /* assert(xhv_array != 0) */ + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != len) + continue; + if (memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + found = 1; + break; + } + if (!found) { + entry = new_he(); + HeKEY_hek(entry) = save_hek(str, len, hash); + HeVAL(entry) = Nullsv; + HeNEXT(entry) = *oentry; + *oentry = entry; + xhv->xhv_keys++; + if (i) { /* initial entry? */ + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) + hsplit(strtab); + } + } + + ++HeVAL(entry); /* use value slot as REFCNT */ + return HeKEY_hek(entry); +} + +