Skip to content

Commit

Permalink
switch_locale_context: Add aTHX
Browse files Browse the repository at this point in the history
This fixes GH #21040

Instead of a dTHX, this passes aTHX automatically, and skips calling
this function if there is no valid context.

It moves that decision into the macro itself, avoiding some #ifdef
directives.

And it adds explanation

f
  • Loading branch information
khwilliamson committed May 21, 2023
1 parent ab40fed commit 2a500d0
Show file tree
Hide file tree
Showing 7 changed files with 44 additions and 25 deletions.
3 changes: 0 additions & 3 deletions dist/threads/threads.xs
Original file line number Diff line number Diff line change
Expand Up @@ -220,10 +220,7 @@ S_ithread_set(pTHX_ ithread *thread)
dMY_CXT;
DEBUG_U(PerlIO_printf(Perl_debug_log, "ithread_set about to set MY_CXT context to thread %p; tid=%ld\n", thread, thread->tid));
MY_CXT.context = thread;
#ifdef PERL_SET_NON_tTHX_CONTEXT
PERL_SET_NON_tTHX_CONTEXT(thread->interp);
DEBUG_U(PerlIO_printf(Perl_debug_log, "ithread_set just set MY_CXT context to thread\n"));
#endif
}

STATIC ithread *
Expand Down
2 changes: 1 addition & 1 deletion embed.fnc
Original file line number Diff line number Diff line change
Expand Up @@ -6178,7 +6178,7 @@ Adhp |SSize_t|PerlIO_write |NULLOK PerlIO *f \
|Size_t count
#endif /* defined(USE_PERLIO) */
#if defined(USE_PERL_SWITCH_LOCALE_CONTEXT)
CTop |void |switch_locale_context
Cop |void |switch_locale_context
#endif
#if defined(USE_QUADMATH)
Tdp |bool |quadmath_format_needed \
Expand Down
37 changes: 29 additions & 8 deletions locale.c
Original file line number Diff line number Diff line change
Expand Up @@ -9781,19 +9781,40 @@ S_my_setlocale_debug_string_i(pTHX_
#ifdef USE_PERL_SWITCH_LOCALE_CONTEXT

void
Perl_switch_locale_context()
Perl_switch_locale_context(pTHX)
{
/* libc keeps per-thread locale status information in some configurations.
* So, we can't just switch out aTHX to switch to a new thread. libc has
* to follow along. This routine does that based on per-interpreter
* variables we keep just for this purpose */

/* Can't use pTHX, because we may be called from a place where that
* isn't available */
dTHX;
* variables we keep just for this purpose.
*
* There are two implementations where this is an issue. For the other
* implementations, it doesn't matter because libc is using global values
* that all threads know about. This is true even for the thread-safe
* emulation, as everything to libc is still a global, and we use
* PL_curlocales (for example) to know what the correct locale(s) should
* be, and this variable is under control of aTHX.
*
* The two implementations are where libc keeps thread-specific information
* on its own. These are
*
* POSIX 2008: The current locale is kept by libc as an object. We save
* a copy of that in the per-thread PL_cur_locale_obj, and so
* this routine uses that copy to tell the thread it should be
* operating with that object
* Windows thread-safe locales: A given thread in Windows can be being run
* with per-thread locales, or not. When the thread context
* changes, libc doesn't automatically know if the thread is
* using per-thread locales, nor does it know what the new
* thread's locale is. We keep that information in the
* per-thread variables:
* PL_controls_locale for if this thread is using
* per-thread locales or not
* PL_cur_LC_ALL for what the the locale should be if
* it is a per-thread locale.
*/

if (UNLIKELY( aTHX == NULL
|| PL_veto_switch_non_tTHX_context
if (UNLIKELY( PL_veto_switch_non_tTHX_context
|| PL_phase == PERL_PHASE_CONSTRUCT))
{
return;
Expand Down
22 changes: 11 additions & 11 deletions perl.h
Original file line number Diff line number Diff line change
Expand Up @@ -6495,21 +6495,21 @@ EXTCONST U8 PL_deBruijn_bitpos_tab64[];
#ifdef USE_PERL_SWITCH_LOCALE_CONTEXT
# define PERL_SET_LOCALE_CONTEXT(i) \
STMT_START { \
if (UNLIKELY(PL_veto_switch_non_tTHX_context)) \
Perl_switch_locale_context(); \
if (LIKELY(! PL_veto_switch_non_tTHX_context)) \
Perl_switch_locale_context(i); \
} STMT_END

/* In some Configurations there may be per-thread information that is
* carried in a library instead of perl's tTHX structure. This macro is to
* be used to handle those when tTHX is changed. Only locale handling is
* currently known to be affected. */
# define PERL_SET_NON_tTHX_CONTEXT(i) \
STMT_START { if (i) PERL_SET_LOCALE_CONTEXT(i); } STMT_END
#else
# define PERL_SET_LOCALE_CONTEXT(i) NOOP
# define PERL_SET_LOCALE_CONTEXT(i) NOOP
# define PERL_SET_NON_tTHX_CONTEXT(i) NOOP
#endif

/* In some Configurations there may be per-thread information that is carried
* in a library instead of perl's tTHX structure. This macro is to be used to
* handle those when tTHX is changed. Only locale handling is currently known
* to be affected. */
#define PERL_SET_NON_tTHX_CONTEXT(i) \
STMT_START { PERL_SET_LOCALE_CONTEXT(i); } STMT_END


#ifndef PERL_GET_CONTEXT
# define PERL_GET_CONTEXT PERL_GET_INTERP
#endif
Expand Down
2 changes: 1 addition & 1 deletion proto.h

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion util.c
Original file line number Diff line number Diff line change
Expand Up @@ -3591,7 +3591,7 @@ Perl_set_context(void *t)
}
# endif

PERL_SET_NON_tTHX_CONTEXT(t);
PERL_SET_NON_tTHX_CONTEXT((PerlInterpreter *) t);

#else
PERL_UNUSED_ARG(t);
Expand Down
1 change: 1 addition & 0 deletions win32/win32thread.c
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ Perl_set_context(void *t)
#if defined(USE_ITHREADS)
# ifdef USE_DECLSPEC_THREAD
Perl_current_context = t;
PERL_SET_NON_tTHX_CONTEXT(t);
# else
DWORD err = GetLastError();
TlsSetValue(PL_thr_key,t);
Expand Down

0 comments on commit 2a500d0

Please sign in to comment.