Add mutex locking for many-reader/1-writer

The mutex macros already in perl are sufficient to allow us to emulate
this type of locking, which may also be available natively, but I don't
think it is worth the effort to use the native calls.

diff --git a/perl.h b/perl.h
index f837459..8bccfb4 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3366,6 +3366,15 @@ typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex;
 typedef pthread_cond_t perl_cond;
 typedef pthread_key_t  perl_key;
 #  endif
+
+/* Many readers; single writer */
+typedef struct perl_RnW1_mutex {
+    perl_mutex lock;
+    perl_cond  zero_readers;
+    Size_t     readers_count;
+} Perl_W1Rn_mutex_t;
+
+
 #endif /* USE_ITHREADS */
 
 #ifdef PERL_TSA_ACTIVE

diff --git a/thread.h b/thread.h
index e695889..a968a4c 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -273,6 +273,53 @@
     } STMT_END
 #endif /* COND_INIT */
 
+#if defined(MUTEX_LOCK) && defined(MUTEX_UNLOCK)                \
+ && defined(COND_SIGNAL) && defined(COND_WAIT)
+
+/* These emulate native many-reader/1-writer locks.
+ * Basically a locking reader just locks the semaphore long enough to increment
+ * a counter; and similarly decrements it when when through.  Any writer will
+ * run only when the count of readers is 0.  That is because it blocks on that
+ * semaphore (doing a COND_WAIT) until it gets control of it, which won't
+ * happen unless the count becomes 0.  ALL readers and other writers are then
+ * blocked until it releases the semaphore.  The reader whose unlocking causes
+ * the count to become 0 signals any waiting writers, and the system guarantees
+ * that only one gets control at a time */
+
+#  define PERL_READ_LOCK(mutex)                                     \
+    STMT_START {                                                    \
+        MUTEX_LOCK(&mutex.lock);                                    \
+        mutex.readers_count++;                                      \
+        MUTEX_UNLOCK(&mutex.lock);                                  \
+    } STMT_END
+
+#  define PERL_READ_UNLOCK(mutex)                                   \
+    STMT_START {                                                    \
+        MUTEX_LOCK(&mutex.lock);                                    \
+        mutex.readers_count--;                                      \
+        if (mutex.readers_count <= 0) {                             \
+            COND_SIGNAL(&mutex.zero_readers);                       \
+            mutex.readers_count = 0;                                \
+        }                                                           \
+        MUTEX_UNLOCK(&mutex.lock);                                  \
+    } STMT_END
+
+#  define PERL_WRITE_LOCK(mutex)                                    \
+    STMT_START {                                                    \
+        MUTEX_LOCK(&mutex.lock);                                    \
+        do {                                                        \
+            if (mutex.readers_count == 0)                           \
+                break;                                              \
+            COND_WAIT(&mutex.zero_readers, &mutex.lock);            \
+        }                                                           \
+        while (1);                                                  \
+                                                                    \
+        /* Here, the mutex is locked, with no readers */            \
+    } STMT_END
+
+#  define PERL_WRITE_UNLOCK(mutex)  MUTEX_UNLOCK(&mutex.lock)
+#endif
+
 /* DETACH(t) must only be called while holding t->mutex */
 #ifndef DETACH
 #  define DETACH(t) \
@@ -402,6 +449,13 @@
 #  define COND_DESTROY(c)         NOOP
 #endif
 
+#ifndef PERL_READ_LOCK
+#  define PERL_READ_LOCK          NOOP
+#  define PERL_READ_UNLOCK        NOOP
+#  define PERL_WRITE_LOCK         NOOP
+#  define PERL_WRITE_UNLOCK       NOOP
+#endif
+
 #ifndef LOCK_DOLLARZERO_MUTEX
 #  define LOCK_DOLLARZERO_MUTEX   NOOP
 #endif