This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fixed sv_mutex locking for new_SV, del_SV and nice_chunks.
authorMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 3 Oct 1997 15:17:39 +0000 (15:17 +0000)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Fri, 3 Oct 1997 15:17:39 +0000 (15:17 +0000)
p4raw-id: //depot/perl@103

av.c
hv.c
perl.h
sv.c

diff --git a/av.c b/av.c
index b9382a8..8623221 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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()
 {