From 28f529616454c5053896e2e4fb8b189cacd1951a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 22 Mar 2021 07:24:55 -0600 Subject: [PATCH] locks --- ext/POSIX/POSIX.xs | 12 +++++ locale.c | 11 +++++ perl.h | 113 +++++++++++++++++++++++++++++---------------- 3 files changed, 96 insertions(+), 40 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 50ebea7179a0..10eb669e61e0 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3184,7 +3184,9 @@ mblen(s, n = ~0) char * string = SvPV(byte_s, len); if (n < len) len = n; #ifdef USE_MBRLEN + MBRLEN_LOCK_; RETVAL = (SSize_t) mbrlen(string, len, &PL_mbrlen_ps); + MBRLEN_UNLOCK_; if (RETVAL < 0) RETVAL = -1; /* Use mblen() ret code for transparency */ #else @@ -3253,7 +3255,9 @@ wctomb(s, wchar) #ifdef USE_WCRTOMB /* The man pages khw looked at are in agreement that this works. * But probably memzero would too */ + WCRTOMB_LOCK_; RETVAL = wcrtomb(NULL, L'\0', &PL_wcrtomb_ps); + WCRTOMB_UNLOCK_; #else WCTOMB_LOCK_; RETVAL = wctomb(NULL, L'\0'); @@ -3263,7 +3267,9 @@ wctomb(s, wchar) else { /* Not resetting state */ char buffer[MB_LEN_MAX]; #ifdef USE_WCRTOMB + WCRTOMB_LOCK_; RETVAL = wcrtomb(buffer, wchar, &PL_wcrtomb_ps); + WCRTOMB_UNLOCK_; #else /* Locking prevents races, but locales can be switched out without * locking, so this isn't a cure all */ @@ -3282,6 +3288,12 @@ int strcoll(s1, s2) char * s1 char * s2 + CODE: + LC_COLLATE_LOCK; + RETVAL = strcoll(s1, s2); + LC_COLLATE_UNLOCK; + OUTPUT: + RETVAL void strtod(str) diff --git a/locale.c b/locale.c index de88311bf4f3..bf4e897fe1b5 100644 --- a/locale.c +++ b/locale.c @@ -3104,7 +3104,9 @@ Perl_mbtowc_(pTHX_ const wchar_t * pwc, const char * s, const Size_t len) # if defined(USE_MBRTOWC) SETERRNO(0, 0); + MBRTOWC_LOCK_; retval = (SSize_t) mbrtowc((wchar_t *) pwc, s, len, &PL_mbrtowc_ps); + MBRTOWC_UNLOCK_; # else @@ -3293,11 +3295,13 @@ S_my_localeconv(pTHX_ const int item) # endif + LC_MONETARY_LOCK; gwLOCALE_LOCK; retval = copy_localeconv(aTHX_ localeconv(), numeric_locale_is_utf8, monetary_locale_is_utf8); gwLOCALE_UNLOCK; + LC_MONETARY_UNLOCK; # ifdef USE_LOCALE_NUMERIC @@ -6324,14 +6328,19 @@ Perl_my_strerror(pTHX_ const int errnum, int * utf8ness) DEBUG_STRERROR_ENTER(errnum, IN_LC(categories[WHICH_LC_INDEX])); if (IN_LC(categories[WHICH_LC_INDEX])) { + gwLOCALE_LOCK; errstr = savepv(Strerror(errnum)); + gwLOCALE_UNLOCK; + *utf8ness = get_locale_string_utf8ness_i(NULL, WHICH_LC_INDEX, errstr, UTF8NESS_UNKNOWN); } else { const char * orig_locale = toggle_locale_i(WHICH_LC_INDEX, "C"); + gwLOCALE_LOCK; errstr = savepv(Strerror(errnum)); + gwLOCALE_UNLOCK; restore_toggled_locale_i(WHICH_LC_INDEX, orig_locale); @@ -6368,7 +6377,9 @@ Perl_my_strerror(pTHX_ const int errnum, int * utf8ness) orig_CTYPE_locale = toggle_locale_c(LC_CTYPE, desired_locale); orig_MESSAGES_locale = toggle_locale_c(LC_MESSAGES, desired_locale); + gwLOCALE_LOCK; errstr = savepv(Strerror(errnum)); + gwLOCALE_UNLOCK; restore_toggled_locale_c(LC_MESSAGES, orig_MESSAGES_locale); restore_toggled_locale_c(LC_CTYPE, orig_CTYPE_locale); diff --git a/perl.h b/perl.h index 3b26cae5ed0c..dc8c6e035242 100644 --- a/perl.h +++ b/perl.h @@ -6742,11 +6742,6 @@ the plain locale pragma without a parameter (S>) is in effect. # endif #endif -#ifndef LOCALE_LOCK_ -# define LOCALE_LOCK_(cond) NOOP -# define LOCALE_UNLOCK_ NOOP -#endif - /* There are some locale-related functions which may need locking only because * they share some common space across threads, and hence there is the * potential for a race in accessing that space. Most are because their return @@ -6814,7 +6809,6 @@ the plain locale pragma without a parameter (S>) is in effect. # define SETLOCALE_UNLOCK NOOP #endif - /* On systems that don't have per-thread locales, even though we don't * think we are changing the locale ourselves, behind the scenes it does * get changed to whatever the thread's should be, so it has to be an @@ -6824,48 +6818,82 @@ the plain locale pragma without a parameter (S>) is in effect. #define LOCALE_READ_LOCK SETLOCALE_LOCK #define LOCALE_READ_UNLOCK SETLOCALE_UNLOCK -#ifndef LC_NUMERIC_LOCK -# define LC_NUMERIC_LOCK(cond) NOOP -# define LC_NUMERIC_UNLOCK NOOP +/* Below are lock definitions for individual functions that Perl uses. All + * such need to be in terms of the locale category(ies) that affect them, plus + * gwLOCALE_LOCK if they read/write global space. It is best to create a + * definition for each function to hide those details, and allow it to be more + * easily maintained. */ +#ifdef LC_CTYPE_LOCK +# define MBLEN_LOCK_ LC_CTYPE_LOCK +# define MBLEN_UNLOCK_ LC_CTYPE_UNLOCK +# define MBRLEN_LOCK_ LC_CTYPE_LOCK +# define MBRLEN_UNLOCK_ LC_CTYPE_UNLOCK +# define MBTOWC_LOCK_ LC_CTYPE_LOCK +# define MBTOWC_UNLOCK_ LC_CTYPE_UNLOCK +# define MBRTOWC_LOCK_ LC_CTYPE_LOCK +# define MBRTOWC_UNLOCK_ LC_CTYPE_UNLOCK +# define WCTOMB_LOCK_ LC_CTYPE_LOCK +# define WCTOMB_UNLOCK_ LC_CTYPE_UNLOCK +# define WCRTOMB_LOCK_ LC_CTYPE_LOCK +# define WCRTOMB_UNLOCK_ LC_CTYPE_UNLOCK +#else + + /* These non-reentrant versions use global space */ +# define MBLEN_LOCK_ gwLOCALE_LOCK +# define MBLEN_UNLOCK_ gwLOCALE_UNLOCK +# define MBTOWC_LOCK_ gwLOCALE_LOCK +# define MBTOWC_UNLOCK_ gwLOCALE_UNLOCK +# define WCTOMB_LOCK_ gwLOCALE_LOCK +# define WCTOMB_UNLOCK_ gwLOCALE_UNLOCK + + /* Whereas the reentrant versions don't (assuming they are called with a + * per-thread buffer; some have the capability of being called with a NULL + * parameter, which defeats the reentrancy) */ +# define MBRLEN_LOCK_ NOOP +# define MBRLEN_UNLOCK_ NOOP +# define MBRTOWC_LOCK_ NOOP +# define MBRTOWC_UNLOCK_ NOOP +# define WCRTOMB_LOCK_ NOOP +# define WCRTOMB_UNLOCK_ NOOP + +# define LC_CTYPE_LOCK SETLOCALE_LOCK +# define LC_CTYPE_UNLOCK SETLOCALE_UNLOCK #endif -#ifdef LC_CTYPE_LOCK -# ifdef HAS_MBLEN -# define MBLEN_LOCK_ LC_CTYPE_LOCK -# define MBLEN_UNLOCK_ LC_CTYPE_UNLOCK -# endif -# ifdef HAS_MBRLEN -# define MBRLEN_LOCK_ LC_CTYPE_LOCK -# define MBRLEN_UNLOCK_ LC_CTYPE_UNLOCK -# endif -# ifdef HAS_MBTOWC -# define MBTOWC_LOCK_ LC_CTYPE_LOCK -# define MBTOWC_UNLOCK_ LC_CTYPE_UNLOCK -# endif -# ifdef HAS_MBRTOWC -# define MBRTOWC_LOCK_ LC_CTYPE_LOCK -# define MBRTOWC_UNLOCK_ LC_CTYPE_UNLOCK -# endif -# ifdef HAS_WCTOMB -# define WCTOMB_LOCK_ LC_CTYPE_LOCK -# define WCTOMB_UNLOCK_ LC_CTYPE_UNLOCK -# endif -# ifdef HAS_WCRTOMB -# define WCRTOMB_LOCK_ LC_CTYPE_LOCK -# define WCRTOMB_UNLOCK_ LC_CTYPE_UNLOCK -# endif +#if ! defined(LC_COLLATE_LOCK) +# define LC_COLLATE_LOCK SETLOCALE_LOCK +# define LC_COLLATE_UNLOCK SETLOCALE_UNLOCK #endif -# define MBLEN_LOCK_ gwLOCALE_LOCK -# define MBLEN_UNLOCK_ gwLOCALE_UNLOCK +#if ! defined(LC_MESSAGES_LOCK) +# define LC_MESSAGES_LOCK SETLOCALE_LOCK +# define LC_MESSAGES_UNLOCK SETLOCALE_UNLOCK +#endif -# define MBTOWC_LOCK_ gwLOCALE_LOCK -# define MBTOWC_UNLOCK_ gwLOCALE_UNLOCK +#if ! defined(LC_MONETARY_LOCK) +# define LC_MONETARY_LOCK SETLOCALE_LOCK +# define LC_MONETARY_UNLOCK SETLOCALE_UNLOCK +#endif -# define WCTOMB_LOCK_ gwLOCALE_LOCK -# define WCTOMB_UNLOCK_ gwLOCALE_UNLOCK +#ifdef LC_TIME_LOCK +# define STRFTIME_LOCK /* Needs one exclusive lock */ \ + STMT_START { LC_TIME_LOCK; ENV_READ_LOCK; } STMT_END +# define STRFTIME_UNLOCK \ + STMT_START { ENV_READ_UNLOCK; LC_TIME_UNLOCK; } STMT_END +#else +# define STRFTIME_LOCK ENV_LOCK +# define STRFTIME_UNLOCK ENV_UNLOCK + +# define LC_TIME_LOCK SETLOCALE_LOCK +# define LC_TIME_UNLOCK SETLOCALE_UNLOCK +#endif #ifdef USE_LOCALE_NUMERIC +# ifndef LC_NUMERIC_LOCK +# define LC_NUMERIC_LOCK(cond_to_panic_if_already_locked) \ + LOCALE_LOCK_(cond_to_panic_if_already_locked) +# define LC_NUMERIC_UNLOCK LOCALE_UNLOCK_ +# endif /* These macros are for toggling between the underlying locale (UNDERLYING or * LOCAL) and the C locale (STANDARD). (Actually we don't have to use the C @@ -7167,6 +7195,11 @@ cannot have changed since the precalculation. #endif /* !USE_LOCALE_NUMERIC */ +#ifndef LC_NUMERIC_LOCK +# define LC_NUMERIC_LOCK(cond) NOOP +# define LC_NUMERIC_UNLOCK NOOP +#endif + #ifdef USE_LOCALE_THREADS # define ENV_LOCK PERL_WRITE_LOCK(&PL_env_mutex) # define ENV_UNLOCK PERL_WRITE_UNLOCK(&PL_env_mutex)