X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=857bd70fe9cfc982302b920a1a40795e1a236b8e;hb=d20626d86bf3d55ba658adbc2678de4c519cbc6c;hp=e62432d63ef7ad05916c925dc41965f900c5a869;hpb=79072805bf63abe5b5978b5928ab00d360ea3e7f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/hv.c b/hv.c
index e62432d..857bd70 100644
--- a/hv.c
+++ b/hv.c
@@ -1,807 +1,1266 @@
-/* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $
+/*    hv.c
  *
- *    Copyright (c) 1991, Larry Wall
+ *    Copyright (c) 1991-1999, 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"
+#define PERL_IN_HV_C
 #include "perl.h"
 
-static void hsplit();
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+#  define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) )
+#else
+#  define MALLOC_OVERHEAD 16
+#  define ARRAY_ALLOC_BYTES(size) ( ((size) < 64)	\
+				? (size)*sizeof(HE*)	\
+				: (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
+#endif
+
+STATIC HE*
+S_new_he(pTHX)
+{
+    HE* he;
+    LOCK_SV_MUTEX;
+    if (!PL_he_root)
+        more_he();
+    he = PL_he_root;
+    PL_he_root = HeNEXT(he);
+    UNLOCK_SV_MUTEX;
+    return he;
+}
+
+STATIC void
+S_del_he(pTHX_ HE *p)
+{
+    LOCK_SV_MUTEX;
+    HeNEXT(p) = (HE*)PL_he_root;
+    PL_he_root = p;
+    UNLOCK_SV_MUTEX;
+}
 
-static void hfreeentries();
+STATIC void
+S_more_he(pTHX)
+{
+    register HE* he;
+    register HE* heend;
+    New(54, PL_he_root, 1008/sizeof(HE), HE);
+    he = PL_he_root;
+    heend = &he[1008 / sizeof(HE) - 1];
+    while (he < heend) {
+        HeNEXT(he) = (HE*)(he + 1);
+        he++;
+    }
+    HeNEXT(he) = 0;
+}
+
+STATIC HEK *
+S_save_hek(pTHX_ const 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
+Perl_unshare_hek(pTHX_ 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)
-HV *hv;
-char *key;
-U32 klen;
-I32 lval;
+Perl_hv_fetch(pTHX_ HV *hv, const char *key, 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')) {
+	    dTHR;
+	    sv = sv_newmortal();
+	    mg_copy((SV*)hv, sv, key, klen);
+	    PL_hv_fetch_sv = sv;
+	    return &PL_hv_fetch_sv;
+	}
+#ifdef ENV_IS_CASELESS
+	else if (mg_find((SV*)hv,'E')) {
+	    U32 i;
+	    for (i = 0; i < klen; ++i)
+		if (isLOWER(key[i])) {
+		    char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen))));
+		    SV **ret = hv_fetch(hv, nkey, klen, 0);
+		    if (!ret && lval)
+			ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
+		    return ret;
+		}
+	}
+#endif
+    }
+
     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, ARRAY_ALLOC_BYTES(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 = ((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 &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)) {
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    SvTAINTED_on(sv);
+	    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);
+    }
+    return 0;
+}
+
+/* returns a HE * structure with the all fields set */
+/* note that hent_val will be a mortal sv for MAGICAL hashes */
+HE *
+Perl_hv_fetch_ent(pTHX_ 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;
 
-    entry = xhv->xhv_array[hash & xhv->xhv_max];
-    for (; entry; entry = entry->hent_next) {
-	if (entry->hent_hash != hash)		/* strings can't be equal */
+    if (SvRMAGICAL(hv)) {
+	if (mg_find((SV*)hv,'P')) {
+	    dTHR;
+	    sv = sv_newmortal();
+	    keysv = sv_2mortal(newSVsv(keysv));
+	    mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
+	    if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
+		char *k;
+		New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+		HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
+	    }
+	    HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
+	    HeVAL(&PL_hv_fetch_ent_mh) = sv;
+	    return &PL_hv_fetch_ent_mh;
+	}
+#ifdef ENV_IS_CASELESS
+	else if (mg_find((SV*)hv,'E')) {
+	    U32 i;
+	    key = SvPV(keysv, klen);
+	    for (i = 0; i < klen; ++i)
+		if (isLOWER(key[i])) {
+		    SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
+		    (void)strupr(SvPVX(nkeysv));
+		    entry = hv_fetch_ent(hv, nkeysv, 0, 0);
+		    if (!entry && lval)
+			entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
+		    return entry;
+		}
+	}
+#endif
+    }
+
+    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, ARRAY_ALLOC_BYTES(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 (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 entry;
     }
-#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 */
+#ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
+    if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    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;
 }
 
+STATIC void
+S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
+{
+    MAGIC *mg = SvMAGIC(hv);
+    *needs_copy = FALSE;
+    *needs_store = TRUE;
+    while (mg) {
+	if (isUPPER(mg->mg_type)) {
+	    *needs_copy = TRUE;
+	    switch (mg->mg_type) {
+	    case 'P':
+	    case 'S':
+		*needs_store = FALSE;
+	    }
+	}
+	mg = mg->mg_moremagic;
+    }
+}
+
 SV**
-hv_store(hv,key,klen,val,hash)
-HV *hv;
-char *key;
-U32 klen;
-SV *val;
-register I32 hash;
+Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, 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)) {
+	bool needs_copy;
+	bool needs_store;
+	hv_magic_check (hv, &needs_copy, &needs_store);
+	if (needs_copy) {
+	    mg_copy((SV*)hv, val, key, klen);
+	    if (!xhv->xhv_array && !needs_store)
+		return 0;
+#ifdef ENV_IS_CASELESS
+	    else if (mg_find((SV*)hv,'E')) {
+		SV *sv = sv_2mortal(newSVpvn(key,klen));
+		key = strupr(SvPVX(sv));
+		hash = 0;
+	    }
+#endif
 	}
     }
+    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, ARRAY_ALLOC_BYTES(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;
 
-    if (SvMAGICAL(hv)) {
-	MAGIC* mg = SvMAGIC(hv);
-	sv_magic(val, (SV*)hv, tolower(mg->mg_type), key, klen);
-    }
-    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;
-	sv_free(entry->hent_val);
-	entry->hent_val = val;
-	return &entry->hent_val;
+	SvREFCNT_dec(HeVAL(entry));
+	HeVAL(entry) = val;
+	return &HeVAL(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;
+
+    return &HeVAL(entry);
+}
+
+HE *
+Perl_hv_store_ent(pTHX_ 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)) {
+	dTHR;
+ 	bool needs_copy;
+ 	bool needs_store;
+ 	hv_magic_check (hv, &needs_copy, &needs_store);
+ 	if (needs_copy) {
+ 	    bool save_taint = PL_tainted;
+ 	    if (PL_tainting)
+ 		PL_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 && !needs_store)
+ 		return Nullhe;
+#ifdef ENV_IS_CASELESS
+	    else if (mg_find((SV*)hv,'E')) {
+		key = SvPV(keysv, klen);
+		keysv = sv_2mortal(newSVpvn(key,klen));
+		(void)strupr(SvPVX(keysv));
+		hash = 0;
+	    }
+#endif
 	}
     }
-#endif
 
-    return &entry->hent_val;
+    key = SvPV(keysv, klen);
+
+    if (!hash)
+	PERL_HASH(hash, key, klen);
+
+    if (!xhv->xhv_array)
+	Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(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 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 entry;
 }
 
 SV *
-hv_delete(hv,key,klen)
-HV *hv;
-char *key;
-U32 klen;
+Perl_hv_delete(pTHX_ HV *hv, const 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 **svp;
     SV *sv;
-    I32 maxi;
-#ifdef SOME_DBM
-    datum dkey;
-#endif
 
     if (!hv)
 	return Nullsv;
+    if (SvRMAGICAL(hv)) {
+	bool needs_copy;
+	bool needs_store;
+	hv_magic_check (hv, &needs_copy, &needs_store);
+
+	if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
+	    sv = *svp;
+	    mg_clear(sv);
+	    if (!needs_store) {
+		if (mg_find(sv, 'p')) {
+		    sv_unmagic(sv, 'p');        /* No longer an element */
+		    return sv;
+		}
+		return Nullsv;          /* element cannot be deleted */
+	    }
+#ifdef ENV_IS_CASELESS
+	    else if (mg_find((SV*)hv,'E')) {
+		sv = sv_2mortal(newSVpvn(key,klen));
+		key = strupr(SvPVX(sv));
+	    }
+#endif
+        }
+    }
     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
-	    maxi = xhv->xhv_coeffsize;
-	for (s=key,		i=0,	hash = 0;
-			    i < maxi;			/*SUPPRESS 8*/
-	     s++,		i++,	hash *= 5) {
-	    hash += *s * coeff[i];
+	    sv = sv_mortalcopy(HeVAL(entry));
+	if (entry == xhv->xhv_eiter)
+	    HvLAZYDEL_on(hv);
+	else
+	    hv_free_ent(hv, entry);
+	--xhv->xhv_keys;
+	return sv;
+    }
+    return Nullsv;
+}
+
+SV *
+Perl_hv_delete_ent(pTHX_ 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)) {
+	bool needs_copy;
+	bool needs_store;
+	hv_magic_check (hv, &needs_copy, &needs_store);
+
+	if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
+	    sv = HeVAL(entry);
+	    mg_clear(sv);
+	    if (!needs_store) {
+		if (mg_find(sv, 'p')) {
+		    sv_unmagic(sv, 'p');	/* No longer an element */
+		    return sv;
+		}		
+		return Nullsv;		/* element cannot be deleted */
+	    }
+#ifdef ENV_IS_CASELESS
+	    else if (mg_find((SV*)hv,'E')) {
+		key = SvPV(keysv, klen);
+		keysv = sv_2mortal(newSVpvn(key,klen));
+		(void)strupr(SvPVX(keysv));
+		hash = 0; 
+	    }
+#endif
 	}
     }
+    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);
+	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;
+    }
+    return Nullsv;
+}
+
+bool
+Perl_hv_exists(pTHX_ HV *hv, const 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')) {
+	    dTHR;
+	    sv = sv_newmortal();
+	    mg_copy((SV*)hv, sv, key, klen); 
+	    magic_existspack(sv, mg_find(sv, 'p'));
+	    return SvTRUE(sv);
+	}
+#ifdef ENV_IS_CASELESS
+	else if (mg_find((SV*)hv,'E')) {
+	    sv = sv_2mortal(newSVpvn(key,klen));
+	    key = strupr(SvPVX(sv));
+	}
+#endif
+    }
+
+    xhv = (XPVHV*)SvANY(hv);
+#ifndef DYNAMIC_ENV_FETCH
+    if (!xhv->xhv_array)
+	return 0; 
 #endif
+
+    PERL_HASH(hash, key, klen);
+
+#ifdef DYNAMIC_ENV_FETCH
+    if (!xhv->xhv_array) entry = Null(HE*);
+    else
+#endif
+    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;
+    }
+#ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
+    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    SvTAINTED_on(sv);
+	    (void)hv_store(hv,key,klen,sv,hash);
+	    return TRUE;
+	}
+    }
+#endif
+    return FALSE;
+}
+
+
+bool
+Perl_hv_exists_ent(pTHX_ 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')) {
+	    dTHR;		/* just for SvTRUE */
+	    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);
+	}
+#ifdef ENV_IS_CASELESS
+	else if (mg_find((SV*)hv,'E')) {
+	    key = SvPV(keysv, klen);
+	    keysv = sv_2mortal(newSVpvn(key,klen));
+	    (void)strupr(SvPVX(keysv));
+	    hash = 0; 
 	}
 #endif
-	return sv;
     }
-#ifdef SOME_DBM
-    sv = Nullsv;
-    goto do_dbm_delete;
-#else
-    return Nullsv;
+
+    xhv = (XPVHV*)SvANY(hv);
+#ifndef DYNAMIC_ENV_FETCH
+    if (!xhv->xhv_array)
+	return 0; 
+#endif
+
+    key = SvPV(keysv, klen);
+    if (!hash)
+	PERL_HASH(hash, key, klen);
+
+#ifdef DYNAMIC_ENV_FETCH
+    if (!xhv->xhv_array) entry = Null(HE*);
+    else
 #endif
+    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;
+    }
+#ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
+    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+	unsigned long len;
+	char *env = PerlEnv_ENVgetenv_len(key,&len);
+	if (env) {
+	    sv = newSVpvn(env,len);
+	    SvTAINTED_on(sv);
+	    (void)hv_store_ent(hv,keysv,sv,hash);
+	    return TRUE;
+	}
+    }
+#endif
+    return FALSE;
 }
 
-static void
-hsplit(hv)
-HV *hv;
+STATIC void
+S_hsplit(pTHX_ 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 char *a = xhv->xhv_array;
+    register HE **aep;
+    register HE **bep;
     register HE *entry;
     register HE **oentry;
 
-    a = xhv->xhv_array;
-    nomemok = TRUE;
-    Renew(a, newsize, HE*);
-    nomemok = FALSE;
+    PL_nomemok = TRUE;
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+    Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+    if (!a) {
+      PL_nomemok = FALSE;
+      return;
+    }
+#else
+#define MALLOC_OVERHEAD 16
+    New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
     if (!a) {
-	xhv->xhv_dosplit = xhv->xhv_max + 1;	/* never split again */
+      PL_nomemok = FALSE;
+      return;
+    }
+    Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
+    if (oldsize >= 64) {
+	offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
+    }
+    else
+	Safefree(xhv->xhv_array);
+#endif
+
+    PL_nomemok = FALSE;
+    Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);	/* zero 2nd half*/
+    xhv->xhv_max = --newsize;
+    xhv->xhv_array = a;
+    aep = (HE**)a;
+
+    for (i=0; i<oldsize; i++,aep++) {
+	if (!*aep)				/* non-existent */
+	    continue;
+	bep = aep+oldsize;
+	for (oentry = aep, entry = *aep; entry; entry = *oentry) {
+	    if ((HeHASH(entry) & newsize) != i) {
+		*oentry = HeNEXT(entry);
+		HeNEXT(entry) = *bep;
+		if (!*bep)
+		    xhv->xhv_fill++;
+		*bep = entry;
+		continue;
+	    }
+	    else
+		oentry = &HeNEXT(entry);
+	}
+	if (!*aep)				/* everything moved */
+	    xhv->xhv_fill--;
+    }
+}
+
+void
+Perl_hv_ksplit(pTHX_ 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 char *a;
+    register HE **aep;
+    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 = xhv->xhv_array;
+    if (a) {
+	PL_nomemok = TRUE;
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+	Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
+        if (!a) {
+	  PL_nomemok = FALSE;
+	  return;
+	}
+#else
+	New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
+        if (!a) {
+	  PL_nomemok = FALSE;
+	  return;
+	}
+	Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
+	if (oldsize >= 64) {
+	    offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
+	}
+	else
+	    Safefree(xhv->xhv_array);
+#endif
+	PL_nomemok = FALSE;
+	Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
+    }
+    else {
+	Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char);
     }
-    Zero(&a[oldsize], oldsize, HE*);		/* zero 2nd half*/
     xhv->xhv_max = --newsize;
-    xhv->xhv_dosplit = xhv->xhv_max * FILLPCT / 100;
     xhv->xhv_array = a;
+    if (!xhv->xhv_fill)				/* skip rest if no entries */
+	return;
 
-    for (i=0; i<oldsize; i++,a++) {
-	if (!*a)				/* non-existent */
+    aep = (HE**)a;
+    for (i=0; i<oldsize; i++,aep++) {
+	if (!*aep)				/* non-existent */
 	    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 (!*b)
+	for (oentry = aep, entry = *aep; entry; entry = *oentry) {
+	    if ((j = (HeHASH(entry) & newsize)) != i) {
+		j -= i;
+		*oentry = HeNEXT(entry);
+		if (!(HeNEXT(entry) = aep[j]))
 		    xhv->xhv_fill++;
-		*b = entry;
+		aep[j] = entry;
 		continue;
 	    }
 	    else
-		oentry = &entry->hent_next;
+		oentry = &HeNEXT(entry);
 	}
-	if (!*a)				/* everything moved */
+	if (!*aep)				/* everything moved */
 	    xhv->xhv_fill--;
     }
 }
 
 HV *
-newHV(lookat)
-U32 lookat;
+Perl_newHV(pTHX)
 {
     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;
 }
 
+HV *
+Perl_newHVhv(pTHX_ HV *ohv)
+{
+    register HV *hv;
+    STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
+    STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
+
+    hv = newHV();
+    while (hv_max && hv_max + 1 >= hv_fill * 2)
+	hv_max = hv_max / 2;	/* Is always 2^n-1 */
+    HvMAX(hv) = hv_max;
+    if (!hv_fill)
+	return hv;
+
+#if 0
+    if (! SvTIED_mg((SV*)ohv, 'P')) {
+	/* Quick way ???*/
+    } 
+    else 
+#endif
+    {
+	HE *entry;
+	I32 hv_riter = HvRITER(ohv);	/* current root of iterator */
+	HE *hv_eiter = HvEITER(ohv);	/* current entry of iterator */
+	
+	/* Slow way */
+	hv_iterinit(ohv);
+	while (entry = hv_iternext(ohv)) {
+	    hv_store(hv, HeKEY(entry), HeKLEN(entry), 
+		     SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
+	}
+	HvRITER(ohv) = hv_riter;
+	HvEITER(ohv) = hv_eiter;
+    }
+    
+    return hv;
+}
+
 void
-he_free(hent)
-register HE *hent;
+Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 {
-    if (!hent)
+    SV *val;
+
+    if (!entry)
 	return;
-    sv_free(hent->hent_val);
-    Safefree(hent->hent_key);
-    Safefree(hent);
+    val = HeVAL(entry);
+    if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
+	PL_sub_generation++;	/* may be deletion of method from stash */
+    SvREFCNT_dec(val);
+    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;
+Perl_hv_delayfree_ent(pTHX_ 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))
+	PL_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 *hv;
-I32 dodbm;
+Perl_hv_clear(pTHX_ HV *hv)
 {
     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)
-HV *hv;
-I32 dodbm;
+STATIC void
+S_hfreeentries(pTHX_ HV *hv)
 {
-    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 *hv;
-I32 dodbm;
+Perl_hv_undef(pTHX_ HV *hv)
 {
     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;
+Perl_hv_iterinit(pTHX_ HV *hv)
 {
-    register XPVHV* xhv = (XPVHV*)SvANY(hv);
+    register XPVHV* xhv;
+    HE *entry;
+
+    if (!hv)
+	Perl_croak(aTHX_ "Bad hash");
+    xhv = (XPVHV*)SvANY(hv);
+    entry = xhv->xhv_eiter;
+    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;
+    return xhv->xhv_keys;	/* used to be xhv->xhv_fill before 5.004_65 */
 }
 
 HE *
-hv_iternext(hv)
-HV *hv;
+Perl_hv_iternext(pTHX_ HV *hv)
 {
     register XPVHV* xhv;
     register HE *entry;
-#ifdef SOME_DBM
-    datum key;
-#endif
+    HE *oldentry;
+    MAGIC* mg;
 
     if (!hv)
-	fatal("Bad associative array");
+	Perl_croak(aTHX_ "Bad hash");
     xhv = (XPVHV*)SvANY(hv);
-    entry = xhv->xhv_eiter;
-#ifdef SOME_DBM
-    if (xhv->xhv_dbm) {
+    oldentry = entry = xhv->xhv_eiter;
+
+    if (mg = SvTIED_mg((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*);
     }
+#ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
+    if (!entry && HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
+	prime_env_iter();
 #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, ARRAY_ALLOC_BYTES(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;
 }
 
 char *
-hv_iterkey(entry,retlen)
-register HE *entry;
-I32 *retlen;
+Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
 {
-    *retlen = entry->hent_klen;
-    return entry->hent_key;
+    if (HeKLEN(entry) == HEf_SVKEY) {
+	STRLEN len;
+	char *p = SvPV(HeKEY_sv(entry), len);
+	*retlen = len;
+	return p;
+    }
+    else {
+	*retlen = HeKLEN(entry);
+	return HeKEY(entry);
+    }
 }
 
+/* unlike hv_iterval(), this always returns a mortal copy of the key */
 SV *
-hv_iterval(hv,entry)
-HV *hv;
-register HE *entry;
+Perl_hv_iterkeysv(pTHX_ register HE *entry)
 {
-#ifdef SOME_DBM
-    register XPVHV* xhv;
-    datum key, content;
+    if (HeKLEN(entry) == HEf_SVKEY)
+	return sv_mortalcopy(HeKEY_sv(entry));
+    else
+	return sv_2mortal(newSVpvn((HeKLEN(entry) ? HeKEY(entry) : ""),
+				  HeKLEN(entry)));
+}
 
-    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);
+SV *
+Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
+{
+    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 <fcntl.h>
-#  endif
-#  ifdef I_SYS_FILE
-#    include <sys/file.h>
-#  endif
-#endif
+SV *
+Perl_hv_iternextsv(pTHX_ 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
+Perl_hv_magic(pTHX_ 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*	
+Perl_sharepvn(pTHX_ const 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;
+Perl_unsharepvn(pTHX_ const 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(PL_strtab, tmpsv, FALSE, hash))) {
+	if (--*Svp == Nullsv)
+	    hv_delete(PL_strtab, str, len, G_DISCARD, hash);
+    } */
+    xhv = (XPVHV*)SvANY(PL_strtab);
+    /* assert(xhv_array != 0) */
+    LOCK_STRTAB_MUTEX;
+    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;
+    }
+    UNLOCK_STRTAB_MUTEX;
+    
+    {
+        dTHR;
+        if (!found && ckWARN_d(WARN_INTERNAL))
+	    Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string");    
     }
-    else if (dowarn)
-	warn("Close on unopened dbm file");
 }
 
-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 *
+Perl_share_hek(pTHX_ const 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(PL_strtab, str, len, FALSE)))
+    	hv_store(PL_strtab, str, len, Nullsv, hash);
+    */
+    xhv = (XPVHV*)SvANY(PL_strtab);
+    /* assert(xhv_array != 0) */
+    LOCK_STRTAB_MUTEX;
+    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(PL_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;
-		}
+    ++HeVAL(entry);				/* use value slot as REFCNT */
+    UNLOCK_STRTAB_MUTEX;
+    return HeKEY_hek(entry);
+}
 
-		    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);
-}