From fba3b22e783d72569126ff6fe76f3cb6cd1f043b Mon Sep 17 00:00:00 2001
From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Date: Fri, 3 Oct 1997 15:17:39 +0000
Subject: [PATCH] Fixed sv_mutex locking for new_SV, del_SV and nice_chunks.

p4raw-id: //depot/perl@103
---
 av.c   |  6 ++----
 hv.c   | 12 ++++++------
 perl.h | 13 +++++++++++++
 sv.c   | 34 ++++++++++++++++++++++------------
 4 files changed, 43 insertions(+), 22 deletions(-)

diff --git a/av.c b/av.c
index b9382a8..8623221 100644
--- a/av.c
+++ b/av.c
@@ -90,10 +90,8 @@ I32 key;
 		newmax = tmp - 1;
 		New(2,ary, newmax+1, SV*);
 		Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
-		if (AvMAX(av) > 64 && !nice_chunk) {
-		    nice_chunk = (char*)AvALLOC(av);
-		    nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*);
-		}
+		if (AvMAX(av) > 64)
+		    offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
 		else
 		    Safefree(AvALLOC(av));
 		AvALLOC(av) = ary;
diff --git a/hv.c b/hv.c
index 454ee23..1e2c81b 100644
--- a/hv.c
+++ b/hv.c
@@ -618,9 +618,9 @@ HV *hv;
     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;
+    if (oldsize >= 64) {
+	offer_nice_chunk(xhv->xhv_array,
+			 oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
     }
     else
 	Safefree(xhv->xhv_array);
@@ -692,9 +692,9 @@ IV newmax;
 	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;
+	if (oldsize >= 64) {
+	    offer_nice_chunk(xhv->xhv_array,
+			     oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
 	}
 	else
 	    Safefree(xhv->xhv_array);
diff --git a/perl.h b/perl.h
index 824f76a..60b0e17 100644
--- a/perl.h
+++ b/perl.h
@@ -2278,5 +2278,18 @@ EXT bool	numeric_local INIT(TRUE);    /* Assume local numerics */
 #define printf PerlIO_stdoutf
 #endif
 
+/*
+ * nice_chunk and nice_chunk size need to be set
+ * and queried under the protection of sv_mutex
+ */
+#define offer_nice_chunk(chunk, chunk_size) do {	\
+	MUTEX_LOCK(&sv_mutex);				\
+	if (!nice_chunk) {				\
+	    nice_chunk = (char*)(chunk);		\
+	    nice_chunk_size = (chunk_size);		\
+	}						\
+	MUTEX_UNLOCK(&sv_mutex);			\
+    } while (0)
+
 #endif /* Include guard */
 
diff --git a/sv.c b/sv.c
index bdc3c71..e4214c6 100644
--- a/sv.c
+++ b/sv.c
@@ -65,14 +65,18 @@ typedef void (*SVFUNC) _((SV*));
 
 #define new_SV(p)			\
     do {				\
+	MUTEX_LOCK(&sv_mutex);		\
 	(p) = (SV*)safemalloc(sizeof(SV)); \
 	reg_add(p);			\
+	MUTEX_UNLOCK(&sv_mutex);	\
     } while (0)
 
 #define del_SV(p)			\
     do {				\
+	MUTEX_LOCK(&sv_mutex);		\
 	reg_remove(p);			\
         free((char*)(p));		\
+	MUTEX_UNLOCK(&sv_mutex);	\
     } while (0)
 
 static SV **registry;
@@ -171,28 +175,33 @@ U32 flags;
 	--sv_count;			\
     } while (0)
 
+/* sv_mutex must be held while calling uproot_SV() */
 #define uproot_SV(p)			\
     do {				\
-	MUTEX_LOCK(&sv_mutex);		\
 	(p) = sv_root;			\
 	sv_root = (SV*)SvANY(p);	\
 	++sv_count;			\
-	MUTEX_UNLOCK(&sv_mutex);	\
     } while (0)
 
-#define new_SV(p)			\
-    if (sv_root)			\
-	uproot_SV(p);			\
-    else				\
-	(p) = more_sv()
+#define new_SV(p)	do {		\
+	MUTEX_LOCK(&sv_mutex);		\
+	if (sv_root)			\
+	    uproot_SV(p);		\
+	else				\
+	    (p) = more_sv();		\
+	MUTEX_UNLOCK(&sv_mutex);	\
+    } while (0)
 
 #ifdef DEBUGGING
 
-#define del_SV(p)			\
-    if (debug & 32768)			\
-	del_sv(p);			\
-    else				\
-	plant_SV(p)
+#define del_SV(p)	do {		\
+	MUTEX_LOCK(&sv_mutex);		\
+	if (debug & 32768)		\
+	    del_sv(p);			\
+	else				\
+	    plant_SV(p);		\
+	MUTEX_UNLOCK(&sv_mutex);	\
+    } while (0)
 
 static void
 del_sv(p)
@@ -253,6 +262,7 @@ U32 flags;
     SvFLAGS(sv) = SVTYPEMASK;
 }
 
+/* sv_mutex must be held while calling more_sv() */
 static SV*
 more_sv()
 {
-- 
2.7.4