In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/061637ca0171c453caf66ea67feedd3b26833499?hp=a3c775652e11bdb1349501ca6c6978da2f07d62b>
- Log ----------------------------------------------------------------- commit 061637ca0171c453caf66ea67feedd3b26833499 Author: Hugo van der Sanden <[email protected]> Date: Wed Jul 31 13:29:49 2019 +0100 [perl #134172] perldelta commit 39b0ad1783fa21aad82d068e668313a54729d740 Author: Hugo van der Sanden <[email protected]> Date: Mon Jul 22 17:08:45 2019 +0100 [perl #134172] Avoid multiple checks of IN_LC(LC_NUMERIC) This adds new API macros STORE_LC_NUMERIC_SET_TO_NEEDED_IN and WITH_LC_NUMERIC_SET_TO_NEEDED_IN that accept a precalculated value for the hints checks of IN_LC(LC_NUMERIC). commit a06a4d45d476265b6d5143171126fe6f33ef2c44 Author: Hugo van der Sanden <[email protected]> Date: Mon Jul 22 16:29:13 2019 +0100 [perl #134172] restrict scope of locale changes during sprintf In some environments we must hold a mutex for the duration of a temporary locale change, so we must ensure that mutex is released appropriately. This means intervening code must not croak, or otherwise bypass the unlock. In sv_vcatpvfn_flags(), that requirement was violated when attempting to avoid multiple temporary locale changes by collapsing them into a single one. This partially undoes that to fix the problem, while still attempting to retain some of the benefits by caching the expensive hints check. ----------------------------------------------------------------------- Summary of changes: perl.h | 68 ++++++++++++++++++++++++++++++--- pod/perldelta.pod | 8 ++++ sv.c | 111 +++++++++++++++++++++++++++--------------------------- 3 files changed, 127 insertions(+), 60 deletions(-) diff --git a/perl.h b/perl.h index c993eccdb9..1b14e9c49a 100644 --- a/perl.h +++ b/perl.h @@ -6411,7 +6411,15 @@ argument list, like this: On threaded perls not operating with thread-safe functionality, this macro uses a mutex to force a critical section. Therefore the matching RESTORE should be -close by, and guaranteed to be called. +close by, and guaranteed to be called; see L</WITH_LC_NUMERIC_SET_TO_NEEDED> +for a more contained way to ensure that. + +=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric + +Same as L</STORE_LC_NUMERIC_SET_TO_NEEDED_IN> with in_lc_numeric provided +as the precalculated value of C<IN_LC(LC_NUMERIC)>. It is the caller's +responsibility to ensure that the status of C<PL_compiling> and C<PL_hints> +cannot have changed since the precalculation. =for apidoc Am|void|RESTORE_LC_NUMERIC @@ -6432,6 +6440,36 @@ expression, but with an empty argument list, like this: ... } +=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED + +This macro invokes the supplied statement or block within the context +of a L</STORE_LC_NUMERIC_SET_TO_NEEDED> .. L</RESTORE_LC_NUMERIC> pair +if required, so eg: + + WITH_LC_NUMERIC_SET_TO_NEEDED( + SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis) + ); + +is equivalent to: + + { +#ifdef USE_LOCALE_NUMERIC + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_SET_TO_NEEDED(); +#endif + SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis); +#ifdef USE_LOCALE_NUMERIC + RESTORE_LC_NUMERIC(); +#endif + } + +=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric + +Same as L</WITH_LC_NUMERIC_SET_TO_NEEDED> with in_lc_numeric provided +as the precalculated value of C<IN_LC(LC_NUMERIC)>. It is the caller's +responsibility to ensure that the status of C<PL_compiling> and C<PL_hints> +cannot have changed since the precalculation. + =cut */ @@ -6459,12 +6497,13 @@ expression, but with an empty argument list, like this: # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL -# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ +# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \ STMT_START { \ + bool _in_lc_numeric = (in); \ LC_NUMERIC_LOCK( \ - ( ( IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_UNDERLYING) \ - || (! IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_STANDARD)));\ - if (IN_LC(LC_NUMERIC)) { \ + ( ( _in_lc_numeric && _NOT_IN_NUMERIC_UNDERLYING) \ + || (! _in_lc_numeric && _NOT_IN_NUMERIC_STANDARD))); \ + if (_in_lc_numeric) { \ if (_NOT_IN_NUMERIC_UNDERLYING) { \ Perl_set_numeric_underlying(aTHX); \ _restore_LC_NUMERIC_function \ @@ -6480,6 +6519,9 @@ expression, but with an empty argument list, like this: } \ } STMT_END +# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC)) + # define RESTORE_LC_NUMERIC() \ STMT_START { \ if (_restore_LC_NUMERIC_function) { \ @@ -6554,6 +6596,17 @@ expression, but with an empty argument list, like this: __FILE__, __LINE__, PL_numeric_standard)); \ } STMT_END +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ + STMT_START { \ + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric); \ + block; \ + RESTORE_LC_NUMERIC(); \ + } STMT_END; + +# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC), block) + #else /* !USE_LOCALE_NUMERIC */ # define SET_NUMERIC_STANDARD() @@ -6562,10 +6615,15 @@ expression, but with an empty argument list, like this: # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION # define STORE_LC_NUMERIC_SET_STANDARD() # define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() +# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric) # define STORE_LC_NUMERIC_SET_TO_NEEDED() # define RESTORE_LC_NUMERIC() # define LOCK_LC_NUMERIC_STANDARD() # define UNLOCK_LC_NUMERIC_STANDARD() +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ + STMT_START { block; } STMT_END +# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ + STMT_START { block; } STMT_END #endif /* !USE_LOCALE_NUMERIC */ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 0f50116d64..c988864969 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -373,6 +373,14 @@ allows a keyword plugin to parse a subroutine signature while C<use feature semantics similar to regular C<sub> declarations that include signatures. [perl #132474] +=item * + +Since on some platforms we need to hold a mutex when temporarily +switching locales, new macros (C<STORE_LC_NUMERIC_SET_TO_NEEDED_IN>, +C<WITH_LC_NUMERIC_SET_TO_NEEDED> and C<WITH_LC_NUMERIC_SET_TO_NEEDED_IN>) +have been added to make it easier to do this safely and efficiently +as part of [perl #134172]. + =back =head1 Selected Bug Fixes diff --git a/sv.c b/sv.c index 4315fe9b64..df0b601650 100644 --- a/sv.c +++ b/sv.c @@ -11562,7 +11562,9 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal, * The rest of the args have the same meaning as the local vars of the * same name within Perl_sv_vcatpvfn_flags(). * - * It assumes the caller has already done STORE_LC_NUMERIC_SET_TO_NEEDED(); + * The caller's determination of IN_LC(LC_NUMERIC), passed as in_lc_numeric, + * is used to ensure we do the right thing when we need to access the locale's + * numeric radix. * * It requires the caller to make buf large enough. */ @@ -11571,7 +11573,7 @@ static STRLEN S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c, const NV nv, const vcatpvfn_long_double_t fv, bool has_precis, STRLEN precis, STRLEN width, - bool alt, char plus, bool left, bool fill) + bool alt, char plus, bool left, bool fill, bool in_lc_numeric) { /* Hexadecimal floating point. */ char* p = buf; @@ -11778,17 +11780,19 @@ S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c, if (hexradix) { #ifndef USE_LOCALE_NUMERIC - *p++ = '.'; + *p++ = '.'; #else - if (IN_LC(LC_NUMERIC)) { - STRLEN n; + if (in_lc_numeric) { + STRLEN n; + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(TRUE, { const char* r = SvPV(PL_numeric_radix_sv, n); Copy(r, p, n, char); - p += n; - } - else { - *p++ = '.'; - } + }); + p += n; + } + else { + *p++ = '.'; + } #endif } @@ -11894,9 +11898,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p char ebuf[IV_DIG * 4 + NV_DIG + 32]; bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */ #ifdef USE_LOCALE_NUMERIC - DECLARATION_FOR_LC_NUMERIC_MANIPULATION; - bool lc_numeric_set = FALSE; /* called STORE_LC_NUMERIC_SET_TO_NEEDED? */ + bool have_in_lc_numeric = FALSE; #endif + /* we never change this unless USE_LOCALE_NUMERIC */ + bool in_lc_numeric = FALSE; PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS; PERL_UNUSED_ARG(maybe_tainted); @@ -12967,33 +12972,31 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p * below, or implicitly, via an snprintf() variant. * Note also things like ps_AF.utf8 which has * "\N{ARABIC DECIMAL SEPARATOR} as a radix point */ - if (!lc_numeric_set) { - /* only set once and reuse in-locale value on subsequent - * iterations. - * XXX what happens if we die in an eval? - */ - STORE_LC_NUMERIC_SET_TO_NEEDED(); - lc_numeric_set = TRUE; + if (! have_in_lc_numeric) { + in_lc_numeric = IN_LC(LC_NUMERIC); + have_in_lc_numeric = TRUE; } - if (IN_LC(LC_NUMERIC)) { - /* this can't wrap unless PL_numeric_radix_sv is a string - * consuming virtually all the 32-bit or 64-bit address - * space - */ - float_need += (SvCUR(PL_numeric_radix_sv) - 1); - - /* floating-point formats only get utf8 if the radix point - * is utf8. All other characters in the string are < 128 - * and so can be safely appended to both a non-utf8 and utf8 - * string as-is. - * Note that this will convert the output to utf8 even if - * the radix point didn't get output. - */ - if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) { - sv_utf8_upgrade(sv); - has_utf8 = TRUE; - } + if (in_lc_numeric) { + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(TRUE, { + /* this can't wrap unless PL_numeric_radix_sv is a string + * consuming virtually all the 32-bit or 64-bit address + * space + */ + float_need += (SvCUR(PL_numeric_radix_sv) - 1); + + /* floating-point formats only get utf8 if the radix point + * is utf8. All other characters in the string are < 128 + * and so can be safely appended to both a non-utf8 and utf8 + * string as-is. + * Note that this will convert the output to utf8 even if + * the radix point didn't get output. + */ + if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) { + sv_utf8_upgrade(sv); + has_utf8 = TRUE; + } + }); } #endif @@ -13068,7 +13071,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p && !fill && intsize != 'q' ) { - SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis); + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, + SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis) + ); elen = strlen(ebuf); eptr = ebuf; goto float_concat; @@ -13113,7 +13118,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p if (UNLIKELY(hexfp)) { elen = S_format_hexfp(aTHX_ PL_efloatbuf, PL_efloatsize, c, nv, fv, has_precis, precis, width, - alt, plus, left, fill); + alt, plus, left, fill, in_lc_numeric); } else { char *ptr = ebuf + sizeof ebuf; @@ -13169,8 +13174,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p const char* qfmt = quadmath_format_single(ptr); if (!qfmt) Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr); - elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize, - qfmt, nv); + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, + elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize, + qfmt, nv); + ); if ((IV)elen == -1) { if (qfmt != ptr) SAVEFREEPV(qfmt); @@ -13180,11 +13187,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p Safefree(qfmt); } #elif defined(HAS_LONG_DOUBLE) - elen = ((intsize == 'q') - ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv) - : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv)); + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, + elen = ((intsize == 'q') + ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv) + : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv)) + ); #else - elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv); + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, + elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv) + ); #endif GCC_DIAG_RESTORE_STMT; } @@ -13406,16 +13417,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } SvTAINT(sv); - -#ifdef USE_LOCALE_NUMERIC - - if (lc_numeric_set) { - RESTORE_LC_NUMERIC(); /* Done outside loop, so don't have to - save/restore each iteration. */ - } - -#endif - } /* ========================================================================= -- Perl5 Master Repository
