Probe for C11 thread local storage, and use it for threading

Probe for compiler support for C11 thread local storage, and where
available use this for "implicit context" for XS extensions making API
calls for a threaded Perl build. This requires fewer function calls at
the C level than POSIX thread specific storage. We continue to use the
the pthreads approach if the C11 approach is not available.

Most operating systems ship a threaded Perl, and most XS extensions
don't specify PERL_NO_GET_CONTEXT, hence they make a lot of calls to
pthread_getspecific to retrieve the interpreter context to pass into
each Perl API call.

Using thread local storage instead doesn't eliminate all function
calls for a threaded shared object - there is still the need to make
one call to get the TLS block. However, it drastically reduces the
number of calls. For APItest.xs we go from

  $ grep -c 'bl.*pthread_getspecific' ext/XS-APItest/APItest.s
  8339

to

  $ grep -c 'bl.*__tls_get_addr' ext/XS-APItest/APItest.s
  3280

Curiously macOS doesn't support this even with current clang (due to
the MACH-O executable format) , whilst most vendor Unix compilers from
a decade ago support __thread even in C89 mode.

Configure

@@ -860,6 +860,8 @@ d_statfs_f_flags=''
 d_statfs_s=''
 d_static_inline=''
 perl_static_inline=''
+d_thread_local=''
+perl_thread_local=''
 d_fstatvfs=''
 d_statvfs=''
 d_stdio_cnt_lval=''
@@ -19231,6 +19233,129 @@ eval $setvar
 $rm -f a.[co] b.[co]
 $rm_try
 
+: see what flavor, if any, of thread local storage is supported
+echo " "
+echo "Checking to see if your system supports C11 thread local storage..."
+$cat > try.c <<'EOCP'
+#include <stdio.h>
+#include <stdlib.h>
+#include <pthread.h>
+
+static int plus_one = 1;
+static int minus_one = -1;
+
+PROBE_MACRO int *minion;
+
+int callback (const void *a, const void *b) {
+    int val_a = *minion * *(const int *)a;
+    int val_b = *minion * *(const int *)b;
+    return val_a < val_b ? -1 : val_a > val_b;
+}
+
+#define SIZE 8
+
+void *thread_function(void *arg) {
+    /* thread local variables should start zeroed in each thread. */
+    if (minion != NULL) {
+        fprintf(stderr, "__thread variable started with %p, should be NULL\n",
+                minion);
+        exit(2);
+    }
+    minion = &minus_one;
+
+    int array[SIZE];
+    unsigned int i;
+    for (i = 0; i < SIZE; ++i) {
+        /* "Hash randomisation" - this array isn't in sorted order: */
+        array[i ^ 5] = i * i;
+    }
+
+    qsort(array, SIZE, sizeof(int), callback);
+
+    int bad = 0;
+    for (i = 0; i < SIZE; ++i) {
+        int want = (SIZE - 1 - i) * (SIZE - 1 - i);
+        int have = array[i];
+        if (want != have) {
+            ++bad;
+            fprintf(stderr, "array[%u] - want %i, have %i\n", i, want, have);
+        }
+    }
+    if (bad)
+        exit(3);
+
+    return NULL;
+}
+
+int main(int argc, char **argv) {
+    if (minion != NULL) {
+        fprintf(stderr, "__thread variable started with %p, should be NULL\n",
+                minion);
+        exit(4);
+    }
+
+    minion = &plus_one;
+
+    pthread_t tid;
+    int result = pthread_create(&tid, NULL, thread_function, NULL);
+    if (result) {
+        fprintf(stderr, "pthread_create failed (%d)\n", result);
+        exit(5);
+    }
+
+    result = pthread_join(tid, NULL);
+    if (result) {
+        fprintf(stderr, "pthread_join failed (%d)\n", result);
+        exit(6);
+    }
+
+    if (minion == NULL) {
+        fprintf(stderr, "__thread variable should not be NULL\n");
+        exit(7);
+    }
+    if (!(minion == &plus_one && *minion == 1)) {
+        fprintf(stderr, "__thread variable should be %d @ %p, not %d @ %p\n",
+                1, &plus_one, *minion, minion);
+        exit(8);
+    }
+
+    return 0;
+}
+EOCP
+
+# Respect a hint (or previous) value for perl_thread_local, if there is one.
+case "$perl_thread_local" in
+'')	# Check the various possibilities, and break out on success.
+	for thread_local in _Thread_local __thread; do
+		set try -DPROBE_MACRO=$thread_local
+		if eval $compile && $run ./try; then
+			$echo "Your compiler supports $thread_local." >&4
+			val=$define
+			perl_thread_local="$thread_local";
+			break;
+		fi
+		$echo "Your compiler does NOT support $thread_local." >&4
+		val="$undef"
+	done
+	;;
+*thread*|*Thread*) # Some variant of thread local exists.
+	echo "Keeping your $hint value of $perl_thread_local."
+	val=$define
+	;;
+*)  # Unrecognized previous value -- blindly trust the supplied
+	# value and hope it makes sense.  Use old value for
+	# d_thread_local, if there is one.
+	echo "Keeping your $hint value of $perl_thread_local."
+	case "$d_thread_local" in
+		'') val=$define ;;
+		*)  val=$d_thread_local ;;
+	esac
+	;;
+esac
+set d_thread_local
+eval $setvar
+$rm_try
+
 : Check stream access
 $cat >&4 <<EOM
 Checking how to access stdio streams by file descriptor number...
@@ -24883,6 +25008,7 @@ d_tcsetpgrp='$d_tcsetpgrp'
 d_telldir='$d_telldir'
 d_telldirproto='$d_telldirproto'
 d_tgamma='$d_tgamma'
+d_thread_local='$d_thread_local'
 d_thread_safe_nl_langinfo_l='$d_thread_safe_nl_langinfo_l'
 d_time='$d_time'
 d_timegm='$d_timegm'
@@ -25258,6 +25384,7 @@ perl5='$perl5'
 perl='$perl'
 perl_patchlevel='$perl_patchlevel'
 perl_static_inline='$perl_static_inline'
+perl_thread_local='$perl_thread_local'
 perladmin='$perladmin'
 perllibs='$perllibs'
 perlpath='$perlpath'

Cross/config.sh-arm-linux

@@ -600,6 +600,7 @@ d_tcsetpgrp='define'
 d_telldir='define'
 d_telldirproto='define'
 d_tgamma='undef'
+d_thread_local='undef'
 d_thread_safe_nl_langinfo_l='undef'
 d_time='define'
 d_timegm='define'
@@ -967,6 +968,7 @@ perl5='/usr/bin/perl'
 perl=''
 perl_patchlevel=''
 perl_static_inline='static'
+perl_thread_local=''
 perladmin='red@criticalintegration.com'
 perllibs='-lnsl -ldl -lm -lcrypt -lutil -lc'
 perlpath='/usr/bin/perl'

Cross/config.sh-arm-linux-n770

@@ -599,6 +599,7 @@ d_tcsetpgrp='define'
 d_telldir='define'
 d_telldirproto='define'
 d_tgamma='undef'
+d_thread_local='undef'
 d_thread_safe_nl_langinfo_l='undef'
 d_time='define'
 d_timegm='define'
@@ -965,6 +966,7 @@ perl5='/usr/bin/perl'
 perl=''
 perl_patchlevel=''
 perl_static_inline='static'
+perl_thread_local=''
 perladmin='red@criticalintegration.com'
 perllibs='-lnsl -ldl -lm -lcrypt -lutil -lc'
 perlpath='/usr/bin/perl'

NetWare/config.wc

@@ -590,6 +590,7 @@ d_tcsetpgrp='undef'
 d_telldir='define'
 d_telldirproto='define'
 d_tgamma='undef'
+d_thread_local='undef'
 d_thread_safe_nl_langinfo_l='undef'
 d_time='define'
 d_timegm='undef'
@@ -941,6 +942,7 @@ path_sep=';'
 perl5=''
 perl='perl'
 perl_static_inline='static'
+perl_thread_local=''
 perladmin=''
 perlpath='~INST_TOP~~INST_VER~\bin~INST_ARCH~\perl.nlm'
 pg=''

Porting/Glossary

@@ -2787,6 +2787,10 @@ d_tgamma (d_tgamma.U):
 	indicates to the C program that the tgamma() routine is available
 	for the gamma function.  See also d_lgamma.
 
+d_thread_local (d_thread_local.U):
+	This variable conditionally defines the PERL_THREAD_LOCAL symbol. In
+	turn that gives a linkage specification for thread-local storage.
+
 d_thread_safe_nl_langinfo_l (d_nl_langinfo_l.U):
 	This variable contains the eventual value of the
 	HAS_THREAD_SAFE_NL_LANGINFO_L symbol, which indicates if the
@@ -4703,6 +4707,10 @@ PERL_SUBVERSION (Oldsyms.U):
 	development subversions.
 	This value is manually set in patchlevel.h
 
+perl_thread_local (d_thread_local.U):
+	This variable gives the value for the PERL_THREAD_LOCAL symbol (when
+	defined), which gives a linkage specification for thread-local storage.
+
 PERL_VERSION (Oldsyms.U):
 	In a Perl version number such as 5.6.2, this is the 6.
 	This value is manually set in patchlevel.h

Porting/config.sh

@@ -621,6 +621,7 @@ d_tcsetpgrp='define'
 d_telldir='define'
 d_telldirproto='define'
 d_tgamma='define'
+d_thread_local='undef'
 d_thread_safe_nl_langinfo_l='define'
 d_time='define'
 d_timegm='define'
@@ -996,6 +997,7 @@ perl5='/usr/bin/perl'
 perl='perl'
 perl_patchlevel=''
 perl_static_inline='static __inline__'
+perl_thread_local=''
 perladmin='yourname@yourhost.yourplace.com'
 perllibs='-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc'
 perlpath='/opt/perl/bin/perl5.35.4'

config_h.SH

@@ -1073,6 +1073,18 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
 #$d_static_inline HAS_STATIC_INLINE				/**/
 #define PERL_STATIC_INLINE $perl_static_inline	/**/
 
+/* PERL_THREAD_LOCAL:
+ *	This symbol, if defined, gives a linkage specification for thread-local
+ *	storage. For example, for a C11 compiler this will be _Thread_local.
+ *	Beware, some compilers are sensitive to the C language standard they are
+ *	told to parse. For example, suncc defaults to C11, so our probe will
+ *	report that _Thread_local can be used. However, if the -std=c99 is later
+ *	added to the compiler flags, then _Thread_local will become a syntax
+ *	error. Hence it is important for these flags to be consistent between
+ *	probing and use.
+ */
+#$d_thread_local PERL_THREAD_LOCAL $perl_thread_local	/**/
+
 /* USE_STDIO_PTR:
  *	This symbol is defined if the _ptr and _cnt fields (or similar)
  *	of the stdio FILE structure can be used to access the stdio buffer

configure.com

@@ -6554,6 +6554,7 @@ $ WC "d_statfs_f_flags='undef'"
 $ WC "d_statfs_s='undef'"
 $ WC "d_statfsflags='undef'"
 $ WC "d_static_inline='define'"
+$ WC "d_thread_local='undef'" ! see perl_thread_local
 $ WC "d_stdio_cnt_lval='" + d_stdio_cnt_lval + "'"
 $ WC "d_stdio_ptr_lval='" + d_stdio_ptr_lval + "'"
 $ WC "d_stdio_ptr_lval_nochange_cnt='" + d_stdio_ptr_lval_nochange_cnt + "'"
@@ -6887,6 +6888,7 @@ $ WC "perllibs='" + perllibs + "'"
 $ WC "perlpath='" + "''vms_prefix':[000000]Perl''exe_ext'" + "'"
 $ WC "perl_static_inline='static inline'"
 $ WC "perl_symbol='" + perl_symbol + "'"  ! VMS specific
+$ WC "perl_thread_local=''" ! FIXME - as this is ia64 ABI, it may well be supported
 $ WC "perl_verb='" + perl_verb + "'"      ! VMS specific
 $ WC "pgflquota='" + pgflquota + "'"
 $ WC "pidtype='" + pidtype + "'"

globals.c

@@ -30,6 +30,14 @@
  */
 #include "regcomp.h"
 
+/* We need somewhere to declare this. This file seems a good place.
+ * This is not a regular "global" in that we don't know whether it needs to
+ * exist until we include threads.h, and we don't want it as part of any
+ * global struct (if that or something similar is re-introduced. */
+
+#if defined(USE_ITHREADS) && defined(PERL_THREAD_LOCAL)
+PERL_THREAD_LOCAL void *PL_current_context;
+#endif
 
 /*
  * ex: set ts=8 sts=4 sw=4 et:

hints/cygwin.sh

@@ -80,3 +80,9 @@ lddlflags="$lddlflags $ldflags"
 #ldflags="$ldflags -s"
 #ccdlflags="$ccdlflags -s"
 #lddlflags="$lddlflags -s"
+
+# Seems that exporting _Thread_local doesn't work on cygwin. This 6 year old
+# gcc bug suggests that maybe the problem really is binutils, but either way
+# it still doesn't work, despite our probes looking good:
+# https://gcc.gnu.org/bugzilla/show_bug.cgi?id=64697
+d_thread_local=undef

hints/darwin.sh

@@ -535,3 +535,7 @@ esac
 # mkostemp() was autodetected as present but found to not be linkable
 # on 15.6.0.  Unknown what other OS versions are affected.
 d_mkostemp=undef
+
+# Apparently the MACH-O format can't support _Thread_local in shared objects,
+# but clang isn't wise to this, so our probe works but the build fails...
+d_thread_local=undef

makedef.pl

@@ -189,6 +189,10 @@ BEGIN
 # All platforms export boot_DynaLoader unconditionally.
 my %export = ( boot_DynaLoader => 1 );
 
+# d_thread_local not perl_thread_local - see hints/darwin.sh
+++$export{PL_current_context}
+    if defined $Config{d_thread_local} && $define{USE_ITHREADS};
+
 sub try_symbols {
     foreach my $symbol (@_) {
 	++$export{$symbol} unless exists $skip{$symbol};

plan9/config_sh.sample

@@ -600,6 +600,7 @@ d_tcsetpgrp='define'
 d_telldir='undef'
 d_telldirproto='undef'
 d_tgamma='undef'
+d_thread_local='undef'
 d_thread_safe_nl_langinfo_l='undef'
 d_time='define'
 d_timegm='undef'
@@ -948,6 +949,7 @@ perl5=''
 perl=''
 perl_patchlevel=''
 perl_static_inline='static'
+perl_thread_local=''
 perladmin='9trouble@plan9.bell-labs.com'
 perllibs=' '
 perlpath='/bin/perl'

pod/perldelta.pod

@@ -97,7 +97,14 @@ There may well be none in a stable release.
 
 =item *
 
-XXX
+We now probe for compiler support for C11 thread local storage, and where
+available use this for "implicit context" for XS extensions making API calls for
+a threaded Perl build.  This requires fewer function calls at the C level than
+POSIX thread specific storage. We continue to use the the pthreads approach if
+the C11 approach is not available.
+
+F<Configure> run with the defaults will build an unthreaded Perl (which is
+slightly faster), but most operating systems ship a threaded Perl.
 
 =back
 

thread.h

@@ -379,19 +379,39 @@
 #    define PTHREAD_GETSPECIFIC(key) pthread_getspecific(key)
 #endif
 
-#ifndef PERL_GET_CONTEXT
-#  define PERL_GET_CONTEXT	PTHREAD_GETSPECIFIC(PL_thr_key)
-#endif
+#if defined(PERL_THREAD_LOCAL) && !defined(PERL_GET_CONTEXT) && !defined(PERL_SET_CONTEXT)
+/* Use C11 thread-local storage, where possible: */
+#  define PERL_USE_THREAD_LOCAL
+extern PERL_THREAD_LOCAL void *PL_current_context;
+
+#  define PERL_GET_CONTEXT        PL_current_context
+
+/* Set our thread-specific value anyway, in case code is reading it directly. */
+#  define PERL_SET_CONTEXT(t)                                           \
+    STMT_START {                                                        \
+        int _eC_;                                                       \
+        if ((_eC_ = pthread_setspecific(PL_thr_key, PL_current_context = (void *)(t)))) \
+            Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \
+                                 _eC_, __FILE__, __LINE__);             \
+    } STMT_END
+
+#else
+/* else fall back to pthreads */
+
+#  ifndef PERL_GET_CONTEXT
+#    define PERL_GET_CONTEXT	PTHREAD_GETSPECIFIC(PL_thr_key)
+#  endif
 
-#ifndef PERL_SET_CONTEXT
-#  define PERL_SET_CONTEXT(t) \
+#  ifndef PERL_SET_CONTEXT
+#    define PERL_SET_CONTEXT(t) \
     STMT_START {						\
         int _eC_;						\
         if ((_eC_ = pthread_setspecific(PL_thr_key, (void *)(t))))	\
             Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]",	\
                                  _eC_, __FILE__, __LINE__);	\
     } STMT_END
-#endif /* PERL_SET_CONTEXT */
+#  endif /* PERL_SET_CONTEXT */
+#endif /* PERL_THREAD_LOCAL */
 
 #ifndef INIT_THREADS
 #  ifdef NEED_PTHREAD_INIT