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.
Perl · May 7, 2023 · 35a0358 · 35a0358
1 parent a3256a1
commit 35a0358
Show file tree

Hide file tree

Showing 6 changed files with 15 additions and 21 deletions.
diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
@@ -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 *

diff --git a/embed.fnc b/embed.fnc
@@ -6193,7 +6193,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 				\

diff --git a/locale.c b/locale.c
@@ -9844,7 +9844,7 @@ 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
@@ -9853,10 +9853,7 @@ Perl_switch_locale_context()
 
     /* Can't use pTHX, because we may be called from a place where that
      * isn't available */
-    dTHX;
-
-    if (UNLIKELY(   aTHX == NULL
-                 || PL_veto_switch_non_tTHX_context
+    if (UNLIKELY(   PL_veto_switch_non_tTHX_context
                  || PL_phase == PERL_PHASE_CONSTRUCT))
                  /* ??? Xxx || ! PL_perl_controls_locale */
     {

diff --git a/perl.h b/perl.h
@@ -6479,20 +6479,20 @@ EXTCONST U8   PL_deBruijn_bitpos_tab64[];
 #  define PERL_SET_LOCALE_CONTEXT(i)                                        \
       STMT_START {                                                          \
           if (LIKELY(! PL_veto_switch_non_tTHX_context))                    \
-                Perl_switch_locale_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

diff --git a/proto.h b/proto.h
diff --git a/util.c b/util.c
@@ -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);