Skip to content

Commit f890a15

Browse files
committed
switch_locale_context: Add aTHX
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
1 parent 2b99f66 commit f890a15

File tree

7 files changed

+45
-27
lines changed

7 files changed

+45
-27
lines changed

dist/threads/threads.xs

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -232,12 +232,7 @@ STATIC void
232232
S_ithread_set(pTHX_ ithread *thread)
233233
{
234234
dMY_CXT;
235-
DEBUG_U(PerlIO_printf(Perl_debug_log, "ithread_set about to set MY_CXT context to thread %p; tid=%ld\n", thread, thread->tid));
236235
MY_CXT.context = thread;
237-
#ifdef PERL_SET_NON_tTHX_CONTEXT
238-
PERL_SET_NON_tTHX_CONTEXT(thread->interp);
239-
DEBUG_U(PerlIO_printf(Perl_debug_log, "ithread_set just set MY_CXT context to thread\n"));
240-
#endif
241236
}
242237

243238
STATIC ithread *

embed.fnc

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6178,7 +6178,7 @@ Adhp |SSize_t|PerlIO_write |NULLOK PerlIO *f \
61786178
|Size_t count
61796179
#endif /* defined(USE_PERLIO) */
61806180
#if defined(USE_PERL_SWITCH_LOCALE_CONTEXT)
6181-
CTop |void |switch_locale_context
6181+
Cop |void |switch_locale_context
61826182
#endif
61836183
#if defined(USE_QUADMATH)
61846184
Tdp |bool |quadmath_format_needed \

locale.c

Lines changed: 30 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -9971,19 +9971,41 @@ S_my_setlocale_debug_string_i(pTHX_
99719971
#ifdef USE_PERL_SWITCH_LOCALE_CONTEXT
99729972

99739973
void
9974-
Perl_switch_locale_context()
9974+
Perl_switch_locale_context(pTHX)
99759975
{
99769976
/* libc keeps per-thread locale status information in some configurations.
99779977
* So, we can't just switch out aTHX to switch to a new thread. libc has
99789978
* to follow along. This routine does that based on per-interpreter
9979-
* variables we keep just for this purpose */
9980-
9981-
/* Can't use pTHX, because we may be called from a place where that
9982-
* isn't available */
9983-
dTHX;
9979+
* variables we keep just for this purpose.
9980+
*
9981+
* There are two implementations where this is an issue. For the other
9982+
* implementations, it doesn't matter because libc is using global values
9983+
* that all threads know about. This is true even for the thread-safe
9984+
* emulation, as everything to libc is still a global, and we use
9985+
* PL_curlocales (for example) to know what the correct locale(s) should
9986+
* be, and this variable is under control of aTHX.
9987+
*
9988+
* The two implementations are where libc keeps thread-specific information
9989+
* on its own. These are
9990+
*
9991+
* POSIX 2008: The current locale is kept by libc as an object. We save
9992+
* a copy of that in the per-thread PL_cur_locale_obj, and so
9993+
* this routine uses that copy to tell the thread it should be
9994+
* operating with that object
9995+
* Windows thread-safe locales: A given thread in Windows can be being run
9996+
* with per-thread locales, or not. When the thread context
9997+
* changes, libc doesn't automatically know if the thread is
9998+
* using per-thread locales, nor does it know what the new
9999+
* thread's locale is. We keep that information in the
10000+
* per-thread variables:
10001+
* PL_controls_locale indicates if this thread is using
10002+
* per-thread locales or not
10003+
* PL_cur_LC_ALL indicates what the the locale
10004+
* should be if it is a per-thread
10005+
* locale.
10006+
*/
998410007

9985-
if (UNLIKELY( aTHX == NULL
9986-
|| PL_veto_switch_non_tTHX_context
10008+
if (UNLIKELY( PL_veto_switch_non_tTHX_context
998710009
|| PL_phase == PERL_PHASE_CONSTRUCT))
998810010
{
998910011
return;

perl.h

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -6501,21 +6501,21 @@ EXTCONST U8 PL_deBruijn_bitpos_tab64[];
65016501
#ifdef USE_PERL_SWITCH_LOCALE_CONTEXT
65026502
# define PERL_SET_LOCALE_CONTEXT(i) \
65036503
STMT_START { \
6504-
if (UNLIKELY(PL_veto_switch_non_tTHX_context)) \
6505-
Perl_switch_locale_context(); \
6504+
if (LIKELY(! PL_veto_switch_non_tTHX_context)) \
6505+
Perl_switch_locale_context(i); \
65066506
} STMT_END
6507+
6508+
/* In some Configurations there may be per-thread information that is
6509+
* carried in a library instead of perl's tTHX structure. This macro is to
6510+
* be used to handle those when tTHX is changed. Only locale handling is
6511+
* currently known to be affected. */
6512+
# define PERL_SET_NON_tTHX_CONTEXT(i) \
6513+
STMT_START { if (i) PERL_SET_LOCALE_CONTEXT(i); } STMT_END
65076514
#else
6508-
# define PERL_SET_LOCALE_CONTEXT(i) NOOP
6515+
# define PERL_SET_LOCALE_CONTEXT(i) NOOP
6516+
# define PERL_SET_NON_tTHX_CONTEXT(i) NOOP
65096517
#endif
65106518

6511-
/* In some Configurations there may be per-thread information that is carried
6512-
* in a library instead of perl's tTHX structure. This macro is to be used to
6513-
* handle those when tTHX is changed. Only locale handling is currently known
6514-
* to be affected. */
6515-
#define PERL_SET_NON_tTHX_CONTEXT(i) \
6516-
STMT_START { PERL_SET_LOCALE_CONTEXT(i); } STMT_END
6517-
6518-
65196519
#ifndef PERL_GET_CONTEXT
65206520
# define PERL_GET_CONTEXT PERL_GET_INTERP
65216521
#endif

proto.h

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

util.c

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3591,7 +3591,7 @@ Perl_set_context(void *t)
35913591
}
35923592
# endif
35933593

3594-
PERL_SET_NON_tTHX_CONTEXT(t);
3594+
PERL_SET_NON_tTHX_CONTEXT((PerlInterpreter *) t);
35953595

35963596
#else
35973597
PERL_UNUSED_ARG(t);

win32/win32thread.c

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ Perl_set_context(void *t)
1111
#if defined(USE_ITHREADS)
1212
# ifdef USE_DECLSPEC_THREAD
1313
Perl_current_context = t;
14+
PERL_SET_NON_tTHX_CONTEXT(t);
1415
# else
1516
DWORD err = GetLastError();
1617
TlsSetValue(PL_thr_key,t);

0 commit comments

Comments
 (0)