Skip to content

Commit 975f9cc

Browse files
khwilliamsonkhwilliamson
committed
perl.h: Create generic reentrant locks functions
Prior to this commit, the only mutex that could be a reentrant lock was the locale mutex. This commit extracts the code that does that so that other mutexes can easily be made reentrant as well.
1 parent b4915ed commit 975f9cc

File tree

1 file changed

+94
-78
lines changed

1 file changed

+94
-78
lines changed

‎perl.h

+94-78
Original file line numberDiff line numberDiff line change
@@ -6372,6 +6372,93 @@ EXTCONST U8 PL_deBruijn_bitpos_tab64[];
63726372
# define PERL_SET_THX(t) NOOP
63736373
#endif
63746374

6375+
#ifdef WIN32
6376+
/* Windows mutexes are all general semaphores; we don't currently bother
6377+
* with reproducing the same panic behavior as on other systems */
6378+
# define PERL_REENTRANT_LOCK(name, mutex, counter, \
6379+
cond_to_panic_if_already_locked) \
6380+
MUTEX_LOCK(mutex)
6381+
# define PERL_REENTRANT_UNLOCK(name, mutex, counter) MUTEX_UNLOCK(mutex)
6382+
#else
6383+
6384+
/* Simulate a general (or recursive) semaphore on 'mutex' whose name will
6385+
* be displayed as 'name' in any messages. There must be a per-thread
6386+
* variable 'counter', initialized to 0 upon thread creation that this
6387+
* macro otherwise controls and keeps set to the recursion depth of the
6388+
* mutex. 'cond_to_panic_if_already_locked' should be set to '0' for a
6389+
* fully reentrant semaphore. Otherwise set it to a bit of code which will
6390+
* be evaluated if the macro is called recursively. If it evaluates to
6391+
* 'true', it means something is seriously wrong, and the process panics.
6392+
*
6393+
* It locks the mutex if the 'counter' is zero, and then increments
6394+
* 'counter'. Each corresponding UNLOCK decrements 'counter' until it is
6395+
* 0, at which point it actually unlocks the mutex. Since the variable is
6396+
* per-thread, initialized to 0, there is no race with other threads.
6397+
*
6398+
* Clang improperly gives warnings for this, if not silenced:
6399+
* https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks
6400+
*/
6401+
# define PERL_REENTRANT_LOCK(name, mutex, counter, \
6402+
cond_to_panic_if_already_locked) \
6403+
STMT_START { \
6404+
CLANG_DIAG_IGNORE(-Wthread-safety) \
6405+
if (LIKELY(counter <= 0)) { \
6406+
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
6407+
"%s: %d: locking " name "; lock depth=1\n", \
6408+
__FILE__, __LINE__)); \
6409+
) \
6410+
MUTEX_LOCK(mutex); \
6411+
counter = 1; \
6412+
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
6413+
"%s: %d: " name " locked; lock depth=1\n", \
6414+
__FILE__, __LINE__)); \
6415+
) \
6416+
} \
6417+
else { \
6418+
counter++; \
6419+
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
6420+
"%s: %d: avoided locking " name "; new lock" \
6421+
" depth=%d, but will panic if '%s' is true\n", \
6422+
__FILE__, __LINE__, counter, \
6423+
STRINGIFY(cond_to_panic_if_already_locked))); \
6424+
) \
6425+
if (cond_to_panic_if_already_locked) { \
6426+
Perl_croak_nocontext("panic: %s: %d: attempting to lock" \
6427+
name " incompatibly: %s\n", \
6428+
__FILE__, __LINE__, \
6429+
STRINGIFY(cond_to_panic_if_already_locked));\
6430+
} \
6431+
} \
6432+
CLANG_DIAG_RESTORE \
6433+
} STMT_END
6434+
6435+
# define PERL_REENTRANT_UNLOCK(name, mutex, counter) \
6436+
STMT_START { \
6437+
if (LIKELY(counter == 1)) { \
6438+
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
6439+
"%s: %d: unlocking " name "; new lock depth=0\n", \
6440+
__FILE__, __LINE__)); \
6441+
) \
6442+
counter = 0; \
6443+
MUTEX_UNLOCK(mutex); \
6444+
} \
6445+
else if (counter <= 0) { \
6446+
Perl_croak_nocontext("panic: %s: %d: attempting to unlock" \
6447+
" already unlocked " name "; depth was" \
6448+
" %d\n", __FILE__, __LINE__, \
6449+
counter); \
6450+
} \
6451+
else { \
6452+
counter--; \
6453+
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
6454+
"%s: %d: avoided unlocking " name "; new lock depth=%d\n", \
6455+
__FILE__, __LINE__, counter)); \
6456+
) \
6457+
} \
6458+
} STMT_END
6459+
6460+
#endif
6461+
63756462
#ifndef EBCDIC
63766463

63776464
/* The tables below are adapted from
@@ -7067,85 +7154,14 @@ the plain locale pragma without a parameter (S<C<use locale>>) is in effect.
70677154
#else /* Below: Threaded, and locales are supported */
70687155

70697156
/* A locale mutex is required on all such threaded builds. */
7070-
# ifdef WIN32
7157+
# define LOCALE_LOCK_(cond_to_panic_if_already_locked) \
7158+
PERL_REENTRANT_LOCK("locale", \
7159+
&PL_locale_mutex, PL_locale_mutex_depth, \
7160+
cond_to_panic_if_already_locked)
7161+
# define LOCALE_UNLOCK_ \
7162+
PERL_REENTRANT_UNLOCK("locale", \
7163+
&PL_locale_mutex, PL_locale_mutex_depth)
70717164

7072-
/* Windows mutexes are all general semaphores */
7073-
# define LOCALE_LOCK_(dummy) MUTEX_LOCK(&PL_locale_mutex)
7074-
# define LOCALE_UNLOCK_ MUTEX_UNLOCK(&PL_locale_mutex)
7075-
# else
7076-
7077-
/* This mutex simulates a general (or recursive) semaphore. The current
7078-
* thread will lock the mutex if the per-thread variable is zero, and then
7079-
* increments that variable. Each corresponding UNLOCK decrements the
7080-
* variable until it is 0, at which point it actually unlocks the mutex.
7081-
* Since the variable is per-thread, initialized to 0, there is no race
7082-
* with other threads.
7083-
*
7084-
* The single argument is a condition to test for, and if true, to panic.
7085-
* Call it with the constant 0 to suppress the check.
7086-
*
7087-
* Clang improperly gives warnings for this, if not silenced:
7088-
* https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks
7089-
*/
7090-
# define LOCALE_LOCK_(cond_to_panic_if_already_locked) \
7091-
STMT_START { \
7092-
CLANG_DIAG_IGNORE(-Wthread-safety) \
7093-
if (LIKELY(PL_locale_mutex_depth <= 0)) { \
7094-
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
7095-
"%s: %d: locking locale; lock depth=1\n", \
7096-
__FILE__, __LINE__)); \
7097-
) \
7098-
MUTEX_LOCK(&PL_locale_mutex); \
7099-
PL_locale_mutex_depth = 1; \
7100-
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
7101-
"%s: %d: locale locked; lock depth=1\n", \
7102-
__FILE__, __LINE__)); \
7103-
) \
7104-
} \
7105-
else { \
7106-
PL_locale_mutex_depth++; \
7107-
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
7108-
"%s: %d: avoided locking locale; new lock" \
7109-
" depth=%d, but will panic if '%s' is true\n", \
7110-
__FILE__, __LINE__, PL_locale_mutex_depth, \
7111-
STRINGIFY(cond_to_panic_if_already_locked))); \
7112-
) \
7113-
if (cond_to_panic_if_already_locked) { \
7114-
Perl_croak_nocontext("panic: %s: %d: Trying to lock" \
7115-
" locale incompatibly: " \
7116-
STRINGIFY(cond_to_panic_if_already_locked)\
7117-
"\n", __FILE__, __LINE__); \
7118-
} \
7119-
} \
7120-
CLANG_DIAG_RESTORE \
7121-
} STMT_END
7122-
7123-
# define LOCALE_UNLOCK_ \
7124-
STMT_START { \
7125-
if (LIKELY(PL_locale_mutex_depth == 1)) { \
7126-
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
7127-
"%s: %d: unlocking locale; new lock depth=0\n", \
7128-
__FILE__, __LINE__)); \
7129-
) \
7130-
PL_locale_mutex_depth = 0; \
7131-
MUTEX_UNLOCK(&PL_locale_mutex); \
7132-
} \
7133-
else if (PL_locale_mutex_depth <= 0) { \
7134-
Perl_croak_nocontext("panic: %s: %d: attempting to unlock" \
7135-
" already unlocked locale; depth was" \
7136-
" %d\n", __FILE__, __LINE__, \
7137-
PL_locale_mutex_depth); \
7138-
} \
7139-
else { \
7140-
PL_locale_mutex_depth--; \
7141-
UNLESS_PERL_MEM_LOG(DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
7142-
"%s: %d: avoided unlocking locale; new lock depth=%d\n",\
7143-
__FILE__, __LINE__, PL_locale_mutex_depth)); \
7144-
) \
7145-
} \
7146-
} STMT_END
7147-
7148-
# endif
71497165
# if defined(USE_THREADS) && ! defined(USE_THREAD_SAFE_LOCALE)
71507166

71517167
/* By definition, a thread-unsafe locale means we need a critical

0 commit comments

Comments
 (0)