Switch libc per-interpreter data when tTHX changes

As noted in the previous commit, some library functions now keep
per-thread state.  So far the only ones we care about are libc
locale-changing ones.

When perl changes threads by swapping out tTHX, those library functions
need to be called with the new value so that they remain in sync with
what perl thinks the locale should be.

This commit creates a function to do this, and changes the
thread-changing macros to also call this as part of the change.

The commit also creates a mechanism to skip this during thread
destruction.  A thread in its death throes doesn't need to have accurate
locale information, and the information needed to map from thread to
what libc needs to know gets destroyed as part of those throes, while
relics of the thread remain.  I couldn't find a way to accurately know
if we are dealing with a relic or not, so the solution I adopted was to
just not switch during destruction.

This commit completes fixing Perl#20155, EXCEPT for Windows boxes.  That
comes in the next commit.

dist/threads/threads.xs

@@ -241,11 +241,20 @@ S_ithread_clear(pTHX_ ithread *thread)
     S_block_most_signals(&origmask);
 #endif
 
+    int save_veto = PL_veto_switch_non_tTHX_context;
+
     interp = thread->interp;
     if (interp) {
         dTHXa(interp);
 
+        /* We will pretend to be a thread that we are not by switching tTHX,
+         * which doesn't work with things that don't rely on tTHX during
+         * tear-down, as they will tend to rely on a mapping from the tTHX
+         * structure, and that structure is being destroyed. */
+        PL_veto_switch_non_tTHX_context = true;
+
         PERL_SET_CONTEXT(interp);
+
         S_ithread_set(aTHX_ thread);
 
         SvREFCNT_dec(thread->params);
@@ -262,6 +271,8 @@ S_ithread_clear(pTHX_ ithread *thread)
     }
 
     PERL_SET_CONTEXT(aTHX);
+    PL_veto_switch_non_tTHX_context = save_veto;
+
 #ifdef THREAD_SIGNAL_BLOCKING
     S_set_sigmask(&origmask);
 #endif

embed.fnc

@@ -3426,6 +3426,9 @@ S	|char*	|win32_setlocale|int category|NULLOK const char* locale
 pTC	|wchar_t *|Win_utf8_string_to_wstring|NULLOK const char * utf8_string
 pTC	|char *	|Win_wstring_to_utf8_string|NULLOK const wchar_t * wstring
 #    endif
+#    ifdef USE_PERL_SWITCH_LOCALE_CONTEXT
+CopT	|void	|switch_locale_context
+#    endif
 #    if defined(HAS_NL_LANGINFO) || defined(HAS_NL_LANGINFO_L)
 S	|const char*|my_langinfo_i|const nl_item item			\
 				|const unsigned int cat_index		\

locale.c

@@ -6725,6 +6725,40 @@ S_my_setlocale_debug_string_i(pTHX_
                      retval_quote, retval, retval_quote);
 }
 
+#endif
+#ifdef USE_PERL_SWITCH_LOCALE_CONTEXT
+
+void
+Perl_switch_locale_context()
+{
+    /* 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;
+
+    if (UNLIKELY(   aTHX == NULL
+                 || PL_veto_switch_non_tTHX_context
+                 || PL_phase == PERL_PHASE_CONSTRUCT))
+    {
+        return;
+    }
+
+#  ifdef USE_POSIX_2008_LOCALE
+
+    if (! uselocale(PL_cur_locale_obj)) {
+        locale_panic_(Perl_form(aTHX_
+                                "Can't uselocale(%p), LC_ALL supposed to be '%s",
+                                PL_cur_locale_obj, get_LC_ALL_display()));
+    }
+
+#  endif
+
+}
+
 #endif
 
 void

makedef.pl

@@ -386,6 +386,7 @@ sub readvar {
 		    PL_stashpad
 		    PL_stashpadix
 		    PL_stashpadmax
+                    PL_veto_switch_non_tTHX_context
 		    Perl_alloccopstash
 		    Perl_allocfilegv
 		    Perl_clone_params_del

perl.h

@@ -4040,7 +4040,10 @@ out there, Solaris being the most prominent.
 
 /* the traditional thread-unsafe notion of "current interpreter". */
 #ifndef PERL_SET_INTERP
-#  define PERL_SET_INTERP(i)		(PL_curinterp = (PerlInterpreter*)(i))
+#  define PERL_SET_INTERP(i)                                            \
+            STMT_START { PL_curinterp = (PerlInterpreter*)(i);          \
+                         PERL_SET_NON_tTHX_CONTEXT(i);                  \
+            } STMT_END
 #endif
 
 #ifndef PERL_GET_INTERP
@@ -6267,6 +6270,24 @@ EXTCONST U8   PL_deBruijn_bitpos_tab64[];
 #  define PERL_SET_CONTEXT(i)		PERL_SET_INTERP(i)
 #endif
 
+#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();                               \
+      } STMT_END
+#else
+#  define PERL_SET_LOCALE_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
@@ -7877,7 +7898,9 @@ C<strtoul>.
  *    "DynaLoader::_guts" XS_VERSION
  *    XXX in the current implementation, this string is ignored.
  * 2. Declare a typedef named my_cxt_t that is a structure that contains
- *    all the data that needs to be interpreter-local.
+ *    all the data that needs to be interpreter-local that perl controls.  This
+ *    doesn't include things that libc controls, such as the uselocale object
+ *    in Configurations that use it.
  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
  *    (typically put in the BOOT: section).

perlvars.h

@@ -169,6 +169,7 @@ PERLVAR(G, check_mutex,	perl_mutex)	/* Mutex for PL_check */
 #ifdef MULTIPLICITY
 # ifdef USE_ITHREADS
 PERLVAR(G, my_ctx_mutex, perl_mutex)
+PERLVARI(G, veto_switch_non_tTHX_context, int, FALSE)
 # endif
 PERLVARI(G, my_cxt_index, int,	0)
 #endif

proto.h

@@ -5751,6 +5751,10 @@ STATIC void	S_new_numeric(pTHX_ const char* newnum);
 #define PERL_ARGS_ASSERT_NEW_NUMERIC	\
 	assert(newnum)
 #    endif
+#    if defined(USE_PERL_SWITCH_LOCALE_CONTEXT)
+PERL_CALLCONV void	Perl_switch_locale_context(void);
+#define PERL_ARGS_ASSERT_SWITCH_LOCALE_CONTEXT
+#    endif
 #    if defined(USE_POSIX_2008_LOCALE)
 STATIC const char*	S_emulate_setlocale_i(pTHX_ const unsigned int index, const char* new_locale, const recalc_lc_all_t recalc_LC_ALL, const line_t line);
 #define PERL_ARGS_ASSERT_EMULATE_SETLOCALE_I

thread.h

@@ -404,6 +404,7 @@ extern PERL_THREAD_LOCAL void *PL_current_context;
                                         PL_current_context = (void *)(t)))) \
             Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \
                                  _eC_, __FILE__, __LINE__);                 \
+        PERL_SET_NON_tTHX_CONTEXT(t);                                       \
     } STMT_END
 
 #else

util.c

@@ -3740,6 +3740,9 @@ Perl_set_context(void *t)
             Perl_croak_nocontext("panic: pthread_setspecific, error=%d", error);
     }
 #  endif
+
+    PERL_SET_NON_tTHX_CONTEXT(t);
+
 #else
     PERL_UNUSED_ARG(t);
 #endif