X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/79072805bf63abe5b5978b5928ab00d360ea3e7f..14ba8c9ed9cfdc22434f89b374aaf17cc48fd4a0:/hv.c diff --git a/hv.c b/hv.c index e62432d..f63dff8 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-1997, 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; +} -static void hfreeentries(); +void +unshare_hek(hek) +HEK *hek; +{ + unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek)); +} + +/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot + * contains an SV* */ SV** hv_fetch(hv,key,klen,lval) @@ -39,76 +91,139 @@ U32 klen; I32 lval; { register XPVHV* xhv; - register char *s; - register I32 i; - register I32 hash; + register U32 hash; register HE *entry; - register I32 maxi; SV *sv; -#ifdef SOME_DBM - datum dkey,dcontent; -#endif if (!hv) return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + sv = sv_newmortal(); + mg_copy((SV*)hv, sv, key, klen); + Sv = sv; + return &Sv; + } + } + xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) { - if (lval) - Newz(503,xhv->xhv_array, xhv->xhv_max + 1, HE*); + 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; } - /* The hash function we use on symbols has to be equal to the first - * character when taken modulo 128, so that sv_reset() can be implemented - * efficiently. We throw in the second character and the last character - * (times 128) so that long chains of identifiers starting with the - * same letter don't have to be strEQ'ed within hv_fetch(), since it - * compares hash values before trying strEQ(). - */ - if (!xhv->xhv_coeffsize && klen) - hash = klen ? *key + 128 * key[1] + 128 * key[klen-1] : 0; - else { /* use normal coefficients */ - if (klen < xhv->xhv_coeffsize) - maxi = klen; - else - maxi = xhv->xhv_coeffsize; - for (s=key, i=0, hash = 0; - i < maxi; /*SUPPRESS 8*/ - s++, i++, hash *= 5) { - hash += *s * coeff[i]; - } - } + PERL_HASH(hash, key, klen); - entry = 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; + + if ((gotenv = ENV_getenv(key)) != Nullch) { + sv = newSVpv(gotenv,strlen(gotenv)); + SvTAINTED_on(sv); + return hv_store(hv,key,klen,sv,hash); + } } -#ifdef SOME_DBM - if (xhv->xhv_dbm) { - dkey.dptr = key; - dkey.dsize = klen; -#ifdef HAS_GDBM - dcontent = gdbm_fetch(xhv->xhv_dbm,dkey); -#else - dcontent = dbm_fetch(xhv->xhv_dbm,dkey); #endif - if (dcontent.dptr) { /* found one */ - sv = NEWSV(60,dcontent.dsize); - sv_setpvn(sv,dcontent.dptr,dcontent.dsize); - return hv_store(hv,key,klen,sv,hash); /* cache it */ + if (lval) { /* gonna assign to this, so it better be there */ + sv = NEWSV(61,0); + return hv_store(hv,key,klen,sv,hash); + } + 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; } + 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; + + if ((gotenv = ENV_getenv(key)) != Nullch) { + sv = newSVpv(gotenv,strlen(gotenv)); + SvTAINTED_on(sv); + 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(hv,key,klen,sv,hash); + return hv_store_ent(hv,keysv,sv,hash); } return 0; } @@ -119,168 +234,354 @@ HV *hv; char *key; U32 klen; SV *val; -register I32 hash; +register U32 hash; { register XPVHV* xhv; - register char *s; register I32 i; register HE *entry; register HE **oentry; - register I32 maxi; if (!hv) return 0; xhv = (XPVHV*)SvANY(hv); - if (hash) - /*SUPPRESS 530*/ - ; - else if (!xhv->xhv_coeffsize && klen) - hash = klen ? *key + 128 * key[1] + 128 * key[klen-1] : 0; - else { /* use normal coefficients */ - if (klen < xhv->xhv_coeffsize) - maxi = klen; - else - maxi = xhv->xhv_coeffsize; - for (s=key, i=0, hash = 0; - i < maxi; /*SUPPRESS 8*/ - s++, i++, hash *= 5) { - hash += *s * coeff[i]; - } + if (SvMAGICAL(hv)) { + mg_copy((SV*)hv, val, key, klen); + 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) + PERL_HASH(hash, key, klen); if (!xhv->xhv_array) - Newz(505,xhv->xhv_array, xhv->xhv_max + 1, HE*); + Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); - oentry = &(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 = 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)) { - MAGIC* mg = SvMAGIC(hv); - sv_magic(val, (SV*)hv, tolower(mg->mg_type), key, klen); + bool save_taint = tainted; + if (tainting) + tainted = SvTAINTED(keysv); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); + TAINT_IF(save_taint); + if (!xhv->xhv_array + && (SvMAGIC(hv)->mg_moremagic + || (SvMAGIC(hv)->mg_type != 'E' +#ifdef OVERLOAD + && SvMAGIC(hv)->mg_type != 'A' +#endif /* OVERLOAD */ + ))) + return Nullhe; } - for (entry = *oentry; entry; i=0, entry = entry->hent_next) { - if (entry->hent_hash != hash) /* strings can't be equal */ + + 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 & (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 (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; - sv_free(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; - /* hv_dbmstore not necessary here because it's called from sv_setmagic() */ - + xhv->xhv_keys++; if (i) { /* initial entry? */ - xhv->xhv_fill++; -#ifdef SOME_DBM - if (xhv->xhv_dbm && xhv->xhv_max >= DBM_CACHE_MAX) - return &entry->hent_val; -#endif - if (xhv->xhv_fill > xhv->xhv_dosplit) + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) hsplit(hv); } -#ifdef SOME_DBM - else if (xhv->xhv_dbm) { /* is this just a cache for dbm file? */ - void he_delayfree(); - HE* ent; - - ent = xhv->xhv_array[hash & xhv->xhv_max]; - oentry = &ent->hent_next; - ent = *oentry; - while (ent) { /* trim chain down to 1 entry */ - *oentry = ent->hent_next; - he_delayfree(ent); /* no doubt they'll want this next, sigh... */ - ent = *oentry; - } - } -#endif - 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; - I32 maxi; -#ifdef SOME_DBM - datum dkey; -#endif if (!hv) return Nullsv; + 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; - if (!xhv->xhv_coeffsize && klen) - hash = klen ? *key + 128 * key[1] + 128 * key[klen-1] : 0; - else { /* use normal coefficients */ - if (klen < xhv->xhv_coeffsize) - maxi = klen; + + 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 - maxi = xhv->xhv_coeffsize; - for (s=key, i=0, hash = 0; - i < maxi; /*SUPPRESS 8*/ - s++, i++, hash *= 5) { - hash += *s * coeff[i]; + hv_free_ent(hv, entry); + --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; + + key = SvPV(keysv, klen); + + if (!hash) + PERL_HASH(hash, key, klen); - oentry = &(xhv->xhv_array[hash & xhv->xhv_max]); + 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); -#ifdef SOME_DBM - do_dbm_delete: - if (xhv->xhv_dbm) { - dkey.dptr = key; - dkey.dsize = klen; -#ifdef HAS_GDBM - gdbm_delete(xhv->xhv_dbm,dkey); -#else - dbm_delete(xhv->xhv_dbm,dkey); -#endif - } -#endif + if (flags & G_DISCARD) + sv = Nullsv; + else + sv = sv_mortalcopy(HeVAL(entry)); + if (entry == xhv->xhv_eiter) + HvLAZYDEL_on(hv); + else + hv_free_ent(hv, entry); + --xhv->xhv_keys; return sv; } -#ifdef SOME_DBM - sv = Nullsv; - goto do_dbm_delete; -#else return Nullsv; -#endif +} + +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 @@ -288,42 +589,138 @@ 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 = xhv->xhv_array; + a = (HE**)xhv->xhv_array; nomemok = TRUE; +#ifdef STRANGE_MALLOC Renew(a, newsize, HE*); - nomemok = FALSE; - if (!a) { - xhv->xhv_dosplit = xhv->xhv_max + 1; /* never split again */ - return; +#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; - xhv->xhv_dosplit = xhv->xhv_max * FILLPCT / 100; - xhv->xhv_array = a; + xhv->xhv_array = (char*)a; for (i=0; ihent_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--; @@ -331,192 +728,162 @@ HV *hv; } HV * -newHV(lookat) -U32 lookat; +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); - if (lookat) { - xhv->xhv_coeffsize = lookat; - xhv->xhv_max = 7; /* it's a normal associative array */ - xhv->xhv_dosplit = xhv->xhv_max * FILLPCT / 100; - } - else { - xhv->xhv_max = 127; /* it's a symbol table */ - xhv->xhv_dosplit = 128; /* so never split */ - } +#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; -#ifdef SOME_DBM - xhv->xhv_dbm = 0; -#endif (void)hv_iterinit(hv); /* so each() will start off right */ return hv; } void -he_free(hent) -register HE *hent; +hv_free_ent(hv, entry) +HV *hv; +register HE *entry; { - if (!hent) + if (!entry) return; - sv_free(hent->hent_val); - Safefree(hent->hent_key); - Safefree(hent); + if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv)) + sub_generation++; /* may be deletion of method from stash */ + SvREFCNT_dec(HeVAL(entry)); + if (HeKLEN(entry) == HEf_SVKEY) { + SvREFCNT_dec(HeKEY_sv(entry)); + Safefree(HeKEY_hek(entry)); + } + else if (HvSHAREKEYS(hv)) + unshare_hek(HeKEY_hek(entry)); + else + Safefree(HeKEY_hek(entry)); + del_he(entry); } void -he_delayfree(hent) -register HE *hent; +hv_delayfree_ent(hv, entry) +HV *hv; +register HE *entry; { - if (!hent) + if (!entry) return; - sv_2mortal(hent->hent_val); /* free between statements */ - Safefree(hent->hent_key); - Safefree(hent); + if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv)) + sub_generation++; /* may be deletion of method from stash */ + sv_2mortal(HeVAL(entry)); /* free between statements */ + if (HeKLEN(entry) == HEf_SVKEY) { + sv_2mortal(HeKEY_sv(entry)); + Safefree(HeKEY_hek(entry)); + } + else if (HvSHAREKEYS(hv)) + unshare_hek(HeKEY_hek(entry)); + else + Safefree(HeKEY_hek(entry)); + del_he(entry); } void -hv_clear(hv,dodbm) +hv_clear(hv) HV *hv; -I32 dodbm; { register XPVHV* xhv; if (!hv) return; xhv = (XPVHV*)SvANY(hv); - hfreeentries(hv,dodbm); + hfreeentries(hv); xhv->xhv_fill = 0; -#ifndef lint + xhv->xhv_keys = 0; if (xhv->xhv_array) - (void)memzero((char*)xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); -#endif + (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); + + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); } static void -hfreeentries(hv,dodbm) +hfreeentries(hv) HV *hv; -I32 dodbm; { - register XPVHV* xhv; - register HE *hent; - register HE *ohent = Null(HE*); -#ifdef SOME_DBM - datum dkey; - datum nextdkey; -#ifdef HAS_GDBM - GDBM_FILE old_dbm; -#else -#ifdef HAS_NDBM - DBM *old_dbm; -#else - I32 old_dbm; -#endif -#endif -#endif + register HE **array; + register HE *entry; + register HE *oentry = Null(HE*); + I32 riter; + I32 max; if (!hv) return; - xhv = (XPVHV*)SvANY(hv); - if (!xhv->xhv_array) + if (!HvARRAY(hv)) return; -#ifdef SOME_DBM - if ((old_dbm = xhv->xhv_dbm) && dodbm) { -#ifdef HAS_GDBM - while (dkey = gdbm_firstkey(xhv->xhv_dbm), dkey.dptr) { -#else - while (dkey = dbm_firstkey(xhv->xhv_dbm), dkey.dptr) { -#endif - do { -#ifdef HAS_GDBM - nextdkey = gdbm_nextkey(xhv->xhv_dbm, dkey); -#else -#ifdef HAS_NDBM -#ifdef _CX_UX - nextdkey = dbm_nextkey(xhv->xhv_dbm, dkey); -#else - nextdkey = dbm_nextkey(xhv->xhv_dbm); -#endif -#else - nextdkey = nextkey(dkey); -#endif -#endif -#ifdef HAS_GDBM - gdbm_delete(xhv->xhv_dbm,dkey); -#else - dbm_delete(xhv->xhv_dbm,dkey); -#endif - dkey = nextdkey; - } while (dkey.dptr); /* one way or another, this works */ + + riter = 0; + max = HvMAX(hv); + array = HvARRAY(hv); + entry = array[0]; + for (;;) { + if (entry) { + oentry = entry; + entry = HeNEXT(entry); + hv_free_ent(hv, oentry); } + if (!entry) { + if (++riter > max) + break; + entry = array[riter]; + } } - xhv->xhv_dbm = 0; /* now clear just cache */ -#endif (void)hv_iterinit(hv); - /*SUPPRESS 560*/ - while (hent = hv_iternext(hv)) { /* concise but not very efficient */ - he_free(ohent); - ohent = hent; - } - he_free(ohent); -#ifdef SOME_DBM - xhv->xhv_dbm = old_dbm; -#endif - if (SvMAGIC(hv)) - mg_clear(hv); } void -hv_undef(hv,dodbm) +hv_undef(hv) HV *hv; -I32 dodbm; { register XPVHV* xhv; if (!hv) return; xhv = (XPVHV*)SvANY(hv); - hfreeentries(hv,dodbm); + hfreeentries(hv); Safefree(xhv->xhv_array); - xhv->xhv_array = 0; - if (xhv->xhv_coeffsize) { - xhv->xhv_max = 7; /* it's a normal associative array */ - xhv->xhv_dosplit = xhv->xhv_max * FILLPCT / 100; - } - else { - xhv->xhv_max = 127; /* it's a symbol table */ - xhv->xhv_dosplit = 128; /* so never split */ + if (HvNAME(hv)) { + Safefree(HvNAME(hv)); + HvNAME(hv) = 0; } + xhv->xhv_array = 0; + xhv->xhv_max = 7; /* it's a normal hash */ xhv->xhv_fill = 0; -#ifdef SOME_DBM - xhv->xhv_dbm = 0; -#endif - (void)hv_iterinit(hv); /* so each() will start off right */ -} + xhv->xhv_keys = 0; -void -hv_free(hv,dodbm) -register HV *hv; -I32 dodbm; -{ - if (!hv) - return; - hfreeentries(hv,dodbm); - Safefree(HvARRAY(hv)); - Safefree(hv); + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); } I32 hv_iterinit(hv) HV *hv; { - register XPVHV* xhv = (XPVHV*)SvANY(hv); + register XPVHV* xhv; + HE *entry; + + if (!hv) + croak("Bad hash"); + xhv = (XPVHV*)SvANY(hv); + 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); + hv_free_ent(hv, entry); + } xhv->xhv_riter = -1; xhv->xhv_eiter = Null(HE*); return xhv->xhv_fill; @@ -528,72 +895,62 @@ HV *hv; { register XPVHV* xhv; register HE *entry; -#ifdef SOME_DBM - datum key; -#endif + HE *oldentry; + MAGIC* mg; if (!hv) - fatal("Bad associative array"); + croak("Bad hash"); xhv = (XPVHV*)SvANY(hv); - entry = xhv->xhv_eiter; -#ifdef SOME_DBM - if (xhv->xhv_dbm) { + oldentry = entry = xhv->xhv_eiter; + + if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { + SV *key = sv_newmortal(); if (entry) { -#ifdef HAS_GDBM - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; - key = gdbm_nextkey(xhv->xhv_dbm, key); -#else -#ifdef HAS_NDBM -#ifdef _CX_UX - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; - key = dbm_nextkey(xhv->xhv_dbm, key); -#else - key = dbm_nextkey(xhv->xhv_dbm); -#endif /* _CX_UX */ -#else - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; - key = nextkey(key); -#endif -#endif + sv_setsv(key, HeSVKEY_force(entry)); + SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ } else { - Newz(504,entry, 1, HE); - xhv->xhv_eiter = entry; -#ifdef HAS_GDBM - key = gdbm_firstkey(xhv->xhv_dbm); -#else - key = dbm_firstkey(xhv->xhv_dbm); -#endif - } - entry->hent_key = key.dptr; - entry->hent_klen = key.dsize; - if (!key.dptr) { - if (entry->hent_val) - sv_free(entry->hent_val); - Safefree(entry); - xhv->xhv_eiter = Null(HE*); - return Null(HE*); + 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; } - return entry; + magic_nextpack((SV*) hv,mg,key); + if (SvOK(key)) { + /* force key to stay around until next time */ + HeSVKEY_set(entry, SvREFCNT_inc(key)); + return entry; /* beware, hent_val is not set */ + } + if (HeVAL(entry)) + SvREFCNT_dec(HeVAL(entry)); + Safefree(HeKEY_hek(entry)); + del_he(entry); + xhv->xhv_eiter = Null(HE*); + return Null(HE*); } -#endif + if (!xhv->xhv_array) - Newz(506,xhv->xhv_array, xhv->xhv_max + 1, HE*); - 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 = xhv->xhv_array[xhv->xhv_riter]; + Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); + 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); + hv_free_ent(hv, oldentry); + } xhv->xhv_eiter = entry; return entry; @@ -604,8 +961,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 * @@ -613,195 +987,145 @@ hv_iterval(hv,entry) HV *hv; register HE *entry; { -#ifdef SOME_DBM - register XPVHV* xhv; - datum key, content; - - if (!hv) - fatal("Bad associative array"); - xhv = (XPVHV*)SvANY(hv); - if (xhv->xhv_dbm) { - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; -#ifdef HAS_GDBM - content = gdbm_fetch(xhv->xhv_dbm,key); -#else - content = dbm_fetch(xhv->xhv_dbm,key); -#endif - if (!entry->hent_val) - entry->hent_val = NEWSV(62,0); - sv_setpvn(entry->hent_val,content.dptr,content.dsize); + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + SV* sv = sv_newmortal(); + 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; + } } -#endif - return entry->hent_val; + return HeVAL(entry); } -#ifdef SOME_DBM - -#ifndef OP_CREAT -# ifdef I_FCNTL -# include -# endif -# ifdef I_SYS_FILE -# include -# endif -#endif +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); +} -#ifndef OP_RDONLY -#define OP_RDONLY 0 -#endif -#ifndef OP_RDWR -#define OP_RDWR 2 -#endif -#ifndef OP_CREAT -#define OP_CREAT 01000 -#endif +void +hv_magic(hv, gv, how) +HV* hv; +GV* gv; +int how; +{ + sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); +} -bool -hv_dbmopen(hv,fname,mode) -HV *hv; -char *fname; -I32 mode; +char* +sharepvn(sv, len, hash) +char* sv; +I32 len; +U32 hash; { - register XPVHV* xhv; - if (!hv) - return FALSE; - xhv = (XPVHV*)SvANY(hv); -#ifdef HAS_ODBM - if (xhv->xhv_dbm) /* never really closed it */ - return TRUE; -#endif - if (xhv->xhv_dbm) { - hv_dbmclose(hv); - xhv->xhv_dbm = 0; - } - hv_clear(hv, FALSE); /* clear cache */ -#ifdef HAS_GDBM - if (mode >= 0) - xhv->xhv_dbm = gdbm_open(fname, 0, GDBM_WRCREAT,mode, (void *) NULL); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = gdbm_open(fname, 0, GDBM_WRITER, mode, (void *) NULL); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = gdbm_open(fname, 0, GDBM_READER, mode, (void *) NULL); -#else -#ifdef HAS_NDBM - if (mode >= 0) - xhv->xhv_dbm = dbm_open(fname, OP_RDWR|OP_CREAT, mode); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = dbm_open(fname, OP_RDWR, mode); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = dbm_open(fname, OP_RDONLY, mode); -#else - if (dbmrefcnt++) - fatal("Old dbm can only open one database"); - sprintf(buf,"%s.dir",fname); - if (stat(buf, &statbuf) < 0) { - if (mode < 0 || close(creat(buf,mode)) < 0) - return FALSE; - sprintf(buf,"%s.pag",fname); - if (close(creat(buf,mode)) < 0) - return FALSE; - } - xhv->xhv_dbm = dbminit(fname) >= 0; -#endif -#endif - if (!xhv->xhv_array && xhv->xhv_dbm != 0) - Newz(507,xhv->xhv_array, xhv->xhv_max + 1, HE*); - hv_magic(hv, 0, 'D'); - return xhv->xhv_dbm != 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 -hv_dbmclose(hv) -HV *hv; +unsharepvn(str, len, hash) +char* str; +I32 len; +U32 hash; { register XPVHV* xhv; - if (!hv) - fatal("Bad associative array"); - xhv = (XPVHV*)SvANY(hv); - if (xhv->xhv_dbm) { -#ifdef HAS_GDBM - gdbm_close(xhv->xhv_dbm); - xhv->xhv_dbm = 0; -#else -#ifdef HAS_NDBM - dbm_close(xhv->xhv_dbm); - xhv->xhv_dbm = 0; -#else - /* dbmrefcnt--; */ /* doesn't work, rats */ -#endif -#endif + 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; } - else if (dowarn) - warn("Close on unopened dbm file"); + + if (!found) + warn("Attempt to free non-existent shared string"); } -bool -hv_dbmstore(hv,key,klen,sv) -HV *hv; -char *key; -U32 klen; -register SV *sv; +/* 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; - datum dkey, dcontent; - I32 error; + register HE *entry; + register HE **oentry; + register I32 i = 1; + I32 found = 0; - if (!hv) - return FALSE; - xhv = (XPVHV*)SvANY(hv); - if (!xhv->xhv_dbm) - return FALSE; - dkey.dptr = key; - dkey.dsize = klen; - dcontent.dptr = SvPVn(sv); - dcontent.dsize = SvCUR(sv); -#ifdef HAS_GDBM - error = gdbm_store(xhv->xhv_dbm, dkey, dcontent, GDBM_REPLACE); -#else - error = dbm_store(xhv->xhv_dbm, dkey, dcontent, DBM_REPLACE); -#endif - if (error) { - if (errno == EPERM) - fatal("No write permission to dbm file"); - fatal("dbm store returned %d, errno %d, key \"%s\"",error,errno,key); -#ifdef HAS_NDBM - dbm_clearerr(xhv->xhv_dbm); -#endif + /* 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); + } } - return !error; -} -#endif /* SOME_DBM */ - -#ifdef XXX - magictype = MgTYPE(magic); - switch (magictype) { - case 'E': - environ[0] = Nullch; - break; - case 'S': -#ifndef NSIG -#define NSIG 32 -#endif - for (i = 1; i < NSIG; i++) - signal(i, SIG_DFL); /* crunch, crunch, crunch */ - break; - } - - if (magic) { - sv_magic(tmpstr, (SV*)tmpgv, magic, tmps, SvCUR(sv)); - sv_magicset(tmpstr, magic); - } - - if (hv->hv_sv.sv_rare && !sv->sv_magic) - sv_magic(sv, (GV*)hv, hv->hv_sv.sv_rare, key, keylen); -#endif -void -hv_magic(hv, gv, how) -HV* hv; -GV* gv; -I32 how; -{ - sv_magic(hv, gv, how, 0, 0); + ++HeVAL(entry); /* use value slot as REFCNT */ + return HeKEY_hek(entry); } + +