X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=a8d9fbca50fc096cca42abac1cf04ce107297d27;hb=469bf43793110471bf2ceb5e99f0e9cc630d60fe;hp=4f5642f3c3228d6a2a756af33e36bd06da624ec1;hpb=7231175158f8ebe4d4c89fd774d89f1e9de28649;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/hv.c b/hv.c
index 4f5642f..a8d9fbc 100644
--- a/hv.c
+++ b/hv.c
@@ -18,42 +18,51 @@ static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
 #ifndef PERL_OBJECT
 static void hsplit _((HV *hv));
 static void hfreeentries _((HV *hv));
-static HE* more_he _((void));
+static void more_he _((void));
+#endif
+
+#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)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
 #endif
 
 STATIC HE*
 new_he(void)
 {
     HE* he;
-    if (he_root) {
-        he = he_root;
-        he_root = HeNEXT(he);
-        return he;
-    }
-    return more_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
 del_he(HE *p)
 {
-    HeNEXT(p) = (HE*)he_root;
-    he_root = p;
+    LOCK_SV_MUTEX;
+    HeNEXT(p) = (HE*)PL_he_root;
+    PL_he_root = p;
+    UNLOCK_SV_MUTEX;
 }
 
-STATIC HE*
+STATIC void
 more_he(void)
 {
     register HE* he;
     register HE* heend;
-    New(54, he_root, 1008/sizeof(HE), HE);
-    he = he_root;
+    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;
-    return new_he();
 }
 
 STATIC HEK *
@@ -96,8 +105,8 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
 	    dTHR;
 	    sv = sv_newmortal();
 	    mg_copy((SV*)hv, sv, key, klen);
-	    hv_fetch_sv = sv;
-	    return &hv_fetch_sv;
+	    PL_hv_fetch_sv = sv;
+	    return &PL_hv_fetch_sv;
 	}
 #ifdef ENV_IS_CASELESS
 	else if (mg_find((SV*)hv,'E')) {
@@ -121,7 +130,7 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
 	         || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
 #endif
 	                                                          )
-	    Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+	    Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
 	else
 	    return 0;
     }
@@ -176,14 +185,14 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
 	    sv = sv_newmortal();
 	    keysv = sv_2mortal(newSVsv(keysv));
 	    mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
-	    if (!HeKEY_hek(&hv_fetch_ent_mh)) {
+	    if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
 		char *k;
 		New(54, k, HEK_BASESIZE + sizeof(SV*), char);
-		HeKEY_hek(&hv_fetch_ent_mh) = (HEK*)k;
+		HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
 	    }
-	    HeSVKEY_set(&hv_fetch_ent_mh, keysv);
-	    HeVAL(&hv_fetch_ent_mh) = sv;
-	    return &hv_fetch_ent_mh;
+	    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')) {
@@ -209,7 +218,7 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
 	         || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
 #endif
 	                                                          )
-	    Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+	    Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
 	else
 	    return 0;
     }
@@ -299,7 +308,7 @@ hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
 	PERL_HASH(hash, key, klen);
 
     if (!xhv->xhv_array)
-	Newz(505, xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+	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;
@@ -355,9 +364,9 @@ hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
  	bool needs_store;
  	hv_magic_check (hv, &needs_copy, &needs_store);
  	if (needs_copy) {
- 	    bool save_taint = tainted;
- 	    if (tainting)
- 		tainted = SvTAINTED(keysv);
+ 	    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);
@@ -380,7 +389,7 @@ hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
 	PERL_HASH(hash, key, klen);
 
     if (!xhv->xhv_array)
-	Newz(505, xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+	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;
@@ -671,30 +680,29 @@ hsplit(HV *hv)
     register HE *entry;
     register HE **oentry;
 
-    nomemok = TRUE;
+    PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-    Renew(a, newsize * sizeof(HE*), char);
+    Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
     if (!a) {
-      nomemok = FALSE;
+      PL_nomemok = FALSE;
       return;
     }
 #else
 #define MALLOC_OVERHEAD 16
-    New(2, a, newsize*sizeof(HE*) * 2 - MALLOC_OVERHEAD, char);
+    New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
     if (!a) {
-      nomemok = FALSE;
+      PL_nomemok = FALSE;
       return;
     }
     Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
     if (oldsize >= 64) {
-	offer_nice_chunk(xhv->xhv_array,
-			 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
+	offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
     }
     else
 	Safefree(xhv->xhv_array);
 #endif
 
-    nomemok = FALSE;
+    PL_nomemok = FALSE;
     Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);	/* zero 2nd half*/
     xhv->xhv_max = --newsize;
     xhv->xhv_array = a;
@@ -747,36 +755,31 @@ hv_ksplit(HV *hv, IV newmax)
 
     a = xhv->xhv_array;
     if (a) {
-	nomemok = TRUE;
+	PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-	Renew(a, newsize * sizeof(HE*), char);
+	Renew(a, ARRAY_ALLOC_BYTES(newsize), char);
         if (!a) {
-	  nomemok = FALSE;
+	  PL_nomemok = FALSE;
 	  return;
 	}
 #else
-	New(2, a, newsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD, char);
+	New(2, a, ARRAY_ALLOC_BYTES(newsize), char);
         if (!a) {
-	  nomemok = FALSE;
+	  PL_nomemok = FALSE;
 	  return;
 	}
 	Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
 	if (oldsize >= 64) {
-	    offer_nice_chunk(xhv->xhv_array,
-			     oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
+	    offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize));
 	}
 	else
 	    Safefree(xhv->xhv_array);
 #endif
-	nomemok = FALSE;
+	PL_nomemok = FALSE;
 	Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
     }
     else {
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-	Newz(0, a, newsize * sizeof(HE*), char);
-#else
-	Newz(0, a, newsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD, char);
-#endif
+	Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char);
     }
     xhv->xhv_max = --newsize;
     xhv->xhv_array = a;
@@ -829,19 +832,18 @@ HV *
 newHVhv(HV *ohv)
 {
     register HV *hv;
-    register XPVHV* xhv;
     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 */
-    ((XPVHV*)SvANY(hv))->xhv_max = hv_max;
+    HvMAX(hv) = hv_max;
     if (!hv_fill)
 	return hv;
 
 #if 0
-    if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) {
+    if (! SvTIED_mg((SV*)ohv, 'P')) {
 	/* Quick way ???*/
     } 
     else 
@@ -852,7 +854,7 @@ newHVhv(HV *ohv)
 	HE *hv_eiter = HvEITER(ohv);	/* current entry of iterator */
 	
 	/* Slow way */
-	hv_iterinit(hv);
+	hv_iterinit(ohv);
 	while (entry = hv_iternext(ohv)) {
 	    hv_store(hv, HeKEY(entry), HeKLEN(entry), 
 		     SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
@@ -873,7 +875,7 @@ hv_free_ent(HV *hv, register HE *entry)
 	return;
     val = HeVAL(entry);
     if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
-	sub_generation++;	/* may be deletion of method from stash */
+	PL_sub_generation++;	/* may be deletion of method from stash */
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
 	SvREFCNT_dec(HeKEY_sv(entry));
@@ -892,7 +894,7 @@ hv_delayfree_ent(HV *hv, register HE *entry)
     if (!entry)
 	return;
     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
-	sub_generation++;	/* may be deletion of method from stash */
+	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));
@@ -1013,7 +1015,7 @@ hv_iternext(HV *hv)
     xhv = (XPVHV*)SvANY(hv);
     oldentry = entry = xhv->xhv_eiter;
 
-    if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
+    if (mg = SvTIED_mg((SV*)hv, 'P')) {
 	SV *key = sv_newmortal();
 	if (entry) {
 	    sv_setsv(key, HeSVKEY_force(entry));
@@ -1045,7 +1047,7 @@ hv_iternext(HV *hv)
     }
 
     if (!xhv->xhv_array)
-	Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+	Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
     if (entry)
 	entry = HeNEXT(entry);
     while (!entry) {
@@ -1142,12 +1144,13 @@ unsharepvn(char *str, I32 len, U32 hash)
     I32 found = 0;
     
     /* what follows is the moral equivalent of:
-    if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
+    if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
 	if (--*Svp == Nullsv)
-	    hv_delete(strtab, str, len, G_DISCARD, hash);
+	    hv_delete(PL_strtab, str, len, G_DISCARD, hash);
     } */
-    xhv = (XPVHV*)SvANY(strtab);
+    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 */
@@ -1167,6 +1170,7 @@ unsharepvn(char *str, I32 len, U32 hash)
 	}
 	break;
     }
+    UNLOCK_STRTAB_MUTEX;
     
     if (!found)
 	warn("Attempt to free non-existent shared string");    
@@ -1187,11 +1191,12 @@ share_hek(char *str, I32 len, register U32 hash)
 
     /* what follows is the moral equivalent of:
        
-    if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
-    	hv_store(strtab, str, len, Nullsv, hash);
+    if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
+    	hv_store(PL_strtab, str, len, Nullsv, hash);
     */
-    xhv = (XPVHV*)SvANY(strtab);
+    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 */
@@ -1213,11 +1218,12 @@ share_hek(char *str, I32 len, register U32 hash)
 	if (i) {				/* initial entry? */
 	    ++xhv->xhv_fill;
 	    if (xhv->xhv_keys > xhv->xhv_max)
-		hsplit(strtab);
+		hsplit(PL_strtab);
 	}
     }
 
     ++HeVAL(entry);				/* use value slot as REFCNT */
+    UNLOCK_STRTAB_MUTEX;
     return HeKEY_hek(entry);
 }