tls.diff

 win32/win32thread.c | 363 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 357 insertions(+), 6 deletions(-)

diff --git a/win32/win32thread.c b/win32/win32thread.c
index 023f3a5aa9..dfb75af95a 100644
--- a/win32/win32thread.c
+++ b/win32/win32thread.c
@@ -1,12 +1,101 @@
+#define PERL_IN_WIN32THREAD_C
 #include "EXTERN.h"
 #include "perl.h"
 
+#include <winnt.h>
+
 #ifdef USE_DECLSPEC_THREAD
 __declspec(thread) void *PL_current_context = NULL;
 #endif
 
-void
-Perl_set_context(void *t)
+
+
+typedef struct _TEB {
+    PVOID Reserved1[12];
+    LPVOID ProcessEnvironmentBlock;
+    PVOID Reserved2[399];
+    BYTE Reserved3[1952];
+    PVOID TlsSlots[64];
+    BYTE Reserved4[8];
+    PVOID Reserved5[26];
+    PVOID ReservedForOle;  // Windows 2000 only
+    PVOID Reserved6[4];
+    PVOID TlsExpansionSlots;
+} TEB, *PTEB;
+
+#if defined(USE_ITHREADS)
+
+#if defined(_M_AMD64)
+static __forceinline void * NtCurrentTebReadPtr(DWORD offset){
+    return (void *)__readgsqword(offset);
+}
+static __forceinline void NtCurrentTebWritePtr(DWORD offset, void * p){
+    __writegsqword(offset, (Size_t)p);
+}
+#elif defined(_M_IX86)
+static __forceinline void * NtCurrentTebReadPtr(DWORD offset){
+    return (void *)__readfsdword(offset);
+}
+static __forceinline void NtCurrentTebWritePtr(DWORD offset, void * p){
+    __writefsdword(offset, (Size_t)p);
+}
+#else
+static __forceinline void * NtCurrentTebReadPtr(DWORD offset){
+    struct _TEB * teb = NtCurrentTeb();
+    Size_t tebszt = (Size_t)teb;
+    Size_t vppszt = (tebszt + offset);
+    void ** vpp = (void**)vppszt;
+    void * retvp = *vpp;
+    return retvp;
+}
+static __forceinline void NtCurrentTebWritePtr(DWORD offset, void * p){
+    struct _TEB * teb = NtCurrentTeb();
+    Size_t tebszt = (Size_t)teb;
+    Size_t vppszt = (tebszt + offset);
+    void ** vpp = (void**)vppszt;
+    *vpp = p;
+}
+#endif
+
+#endif
+// typedef struct {
+    // PFN_GET_CXT pfnGetCxt;
+    // DWORD Key;
+    // USHORT TebOff1;
+    // USHORT TebOff2;
+// } perl_key;
+
+// typedef void * (*w32_gcxtpfn_t)();
+// typedef void * (*pfnGetCxt_t)();
+// typedef void (*w32_scxtpfn_t)(LPVOID);
+
+// static w32_gcxtpfn_t gw32_get_cxt_pfn = NULL;
+// static w32_scxtpfn_t gw32_set_cxt_pfn = NULL;
+
+// static void
+// Perl_set_fastcxt(LPVOID t)
+// {
+// #if defined(USE_ITHREADS)
+// #  ifdef USE_DECLSPEC_THREAD
+    // Perl_current_context = t;
+    // PERL_SET_NON_tTHX_CONTEXT(t);
+// #  else
+    // struct _TEB * teb = NtCurrentTeb();
+    // DWORD key = PL_thr_key;
+
+    // if (key < 64)
+      // teb->TlsSlots[key] = t;
+    // else {
+            // void** vpp = (void**)teb->TlsExpansionSlots;
+            // vpp[key-64] = t;
+    // }
+    // return;
+// #  endif
+// #endif
+// }
+
+static void
+Perl_set_oldcxt(void *t)
 {
 #if defined(USE_ITHREADS)
 #  ifdef USE_DECLSPEC_THREAD
@@ -14,21 +103,58 @@ Perl_set_context(void *t)
     PERL_SET_NON_tTHX_CONTEXT(t);
 #  else
     DWORD err = GetLastError();
-    TlsSetValue(PL_thr_key,t);
+    TlsSetValue(PL_thr_key.Key,t);
     SetLastError(err);
 #  endif
 #endif
 }
 
-void *
-Perl_get_context(void)
+
+
+static void
+Perl_set_fastcxt(void *t)
+{
+#if defined(USE_ITHREADS)
+    //fix upper array missing in new thd bug crash
+    void**  arr_vps = NtCurrentTebReadPtr(PL_thr_key.TebOff1);
+    void** vpp = (void**)(((Size_t)arr_vps)+PL_thr_key.TebOff2);
+    *vpp = t;
+#endif
+    return;
+}
+static void
+Perl_set_fastcxt_lt64(void *t)
+{
+#if defined(USE_ITHREADS)
+    //fix upper array missing in new thd bug crash
+    NtCurrentTebWritePtr(PL_thr_key.TebOff2, t);
+#endif
+    return;
+}
+
+static void
+Perl_set_fastcxt_gte64(void *t)
+{
+#if defined(USE_ITHREADS)
+    void**  arr_vps = NtCurrentTebReadPtr(STRUCT_OFFSET(struct _TEB, TlsExpansionSlots));
+    if(arr_vps) {
+     void** vpp = (void**)(((Size_t)arr_vps)+PL_thr_key.TebOff2);
+              *vpp = t;
+    }else
+      Perl_set_oldcxt(t);
+#endif
+    return;
+}
+
+static void *
+Perl_get_oldcxt()
 {
 #if defined(USE_ITHREADS)
 #  ifdef USE_DECLSPEC_THREAD
     return Perl_current_context;
 #  else
     DWORD err = GetLastError();
-    void *result = TlsGetValue(PL_thr_key);
+    void *result = TlsGetValue(PL_thr_key.Key);
     SetLastError(err);
     return result;
 #  endif
@@ -36,3 +162,228 @@ Perl_get_context(void)
     return NULL;
 #endif
 }
+
+
+
+static void *
+Perl_get_fastcxt()
+{
+#if defined(USE_ITHREADS)
+    //struct _TEB * teb = NtCurrentTeb();
+    //Size_t tebszt = (Size_t)teb;
+    //Size_t p_to_arr_of_vps = (tebszt + PL_thr_key.TebOff1);
+    //void**  arr_vps = *(void***)p_to_arr_of_vps;
+    void**  arr_vps = NtCurrentTebReadPtr(PL_thr_key.TebOff1);
+    void** vpp = (void**)(((Size_t)arr_vps)+PL_thr_key.TebOff2);
+    void* rvp = *vpp;
+    return rvp;
+#else
+    return NULL;
+#endif
+}
+
+static void *
+Perl_get_fastcxt_lt64()
+{
+#if defined(USE_ITHREADS)
+    //fix upper array missing in new thd bug crash
+    return NtCurrentTebReadPtr(PL_thr_key.TebOff2);
+#else
+    return NULL;
+#endif
+}
+
+static void *
+Perl_get_fastcxt_gte64()
+{
+#if defined(USE_ITHREADS)
+    void**  arr_vps = NtCurrentTebReadPtr(STRUCT_OFFSET(struct _TEB, TlsExpansionSlots));
+    if(arr_vps) {
+     void** vpp = (void**)(((Size_t)arr_vps)+PL_thr_key.TebOff2);
+     return *vpp;
+    }
+#endif
+    return NULL;
+}
+
+
+EXTERN_C void *
+Perl_get_contextp(void)
+{
+#if defined(USE_ITHREADS)
+    return Perl_get_context();
+#else
+    return NULL;
+#endif
+
+}
+
+EXTERN_C void
+Perl_set_contextp(void *t)
+{
+#if defined(USE_ITHREADS)
+    Perl_set_context(t);
+#endif
+}
+
+
+#if defined(USE_ITHREADS)
+PFN_GET_CXT Perl_get_context = Perl_get_fastcxt_lt64;
+PFN_SET_CXT Perl_set_context = Perl_set_fastcxt_lt64;
+#endif
+
+void
+win32_alloc_tls() {
+    STATIC_ASSERT_DECL(STRUCT_OFFSET(NT_TIB, Self) < USHRT_MAX);
+    STATIC_ASSERT_DECL(STRUCT_OFFSET(struct _TEB, TlsSlots) < USHRT_MAX);
+    STATIC_ASSERT_DECL(TLS_MINIMUM_AVAILABLE == 64);
+    STATIC_ASSERT_DECL((STRUCT_OFFSET(struct _TEB, TlsSlots)+(TLS_MINIMUM_AVAILABLE*PTRSIZE)) < USHRT_MAX);
+    STATIC_ASSERT_DECL(STRUCT_OFFSET(struct _TEB, TlsExpansionSlots) < USHRT_MAX);
+    STATIC_ASSERT_DECL(((1088-64)*PTRSIZE) < USHRT_MAX);
+#if defined(USE_ITHREADS)
+    void * v1;
+    void * v2;
+    void * v3;
+    DWORD Key;
+    Key = TlsAlloc();
+    if (Key == TLS_OUT_OF_INDEXES)
+        Perl_noperl_die("panic: TlsAlloc");
+    if (PL_thr_key.Key != TLS_OUT_OF_INDEXES) 
+        Perl_noperl_die("panic: TlsAlloc"); /* leak */
+    PL_thr_key.Key = Key;
+    if(Key < 64) { /* the Day 1 TLS slots inlined into TEB */
+        PL_thr_key.TebOff1 = STRUCT_OFFSET(NT_TIB, Self);
+        PL_thr_key.TebOff2 = (STRUCT_OFFSET(struct _TEB, TlsSlots) + (Key*PTRSIZE));
+      } /* These HeapAlloc-ed TLS slots are addons. The actual allocator is UB. */
+    else {     /* The array ptr is NULL until 64 TLS slots are occupied. */
+      PL_thr_key.TebOff1 = STRUCT_OFFSET(struct _TEB, TlsExpansionSlots);
+      PL_thr_key.TebOff2 = ((Key-64)*PTRSIZE);
+    }
+    v1 = (void *)TlsGetValue(Key); /* is NULL here */
+    v2 = Perl_get_oldcxt(); /* sanity */
+    if(v2 != v1)
+        Perl_noperl_die("panic: TlsAlloc");
+    v3 = Perl_get_fastcxt();
+    if(v3 != v1)
+        goto failed; /* what we read, isn't the TLS slot using Public API */
+    TlsSetValue(Key, (void *)0xA1B1);
+    v3 = Perl_get_fastcxt();
+    if(v3 != (void *)0xA1B1) { /* refect from pub to priv */
+        v2 = (void *)TlsGetValue(Key);
+        if(v2 != (void *)0xA1B1) /* TlsSetValue didn't reflect to TlsGetValue,
+        after our non-compat Perl_get_fastcxt() did pure mem reads.
+        Heap corruption happened, without us doing any C *writes* to mem.
+        Must've been an unk 3rd party SEH try{}/catch{} handler, that is broken
+        itself. */
+            Perl_noperl_die("panic: TlsAlloc");
+        goto failed;
+    } /* test priv Get() can't corrupt pub Get(), a WinOS or 3P broken SEH/SEGV
+    page fault trap/resumer tool is in our process, think of C Dbg BPs. */
+    v2 = (void *)TlsGetValue(Key);
+    if(v2 != (void *)0xA1B1)
+        Perl_noperl_die("panic: TlsAlloc");
+    /* Priv Set() must reflect to pub Get(). Make sure no surprise pointer
+    encryption was added. */
+    Perl_set_fastcxt((void *)0xF2E2);
+    v2 = (void *)TlsGetValue(Key);
+    if(v2 != (void *)0xF2E2) /* we probably corrupted some 4b/8b mem block but dont fix it */
+        goto failed;
+    v3 = Perl_get_fastcxt(); /* pub Get() doesn't wipe/change/re-cipher the value */
+    if(v3 != (void *)0xF2E2)
+        goto failed;
+    /* pub Set() must work after a priv Set() */
+    TlsSetValue(Key, (void *)0xA1B1);
+    v3 = Perl_get_fastcxt();
+    if(v3 != (void *)0xA1B1) { /* reflect from pub Set to priv Set */
+        failed:
+        __debugbreak();
+        failed_nopause:
+        Perl_get_context = Perl_get_oldcxt;
+        Perl_set_context = Perl_set_oldcxt;
+        PL_thr_key.TebOff1 = 0;
+        PL_thr_key.TebOff2 = 0;
+    }
+    else { /* offsets were set above */
+        WCHAR wbuf [16];
+        if(GetEnvironmentVariableW(L"PERL_OLDCXT", wbuf, C_ARRAY_LENGTH(wbuf))
+          && wbuf[0] == '1' && wbuf[0] == '\0')
+            goto failed_nopause;
+        if(Key < 64) {
+          if(Perl_get_context != Perl_get_fastcxt_lt64)
+                Perl_get_context = Perl_get_fastcxt_lt64;
+          if(Perl_set_context != Perl_set_fastcxt_lt64)
+              Perl_set_context = Perl_set_fastcxt_lt64;
+        } else {
+            Perl_get_context = Perl_get_fastcxt_gte64;
+            Perl_set_context = Perl_set_fastcxt_gte64;
+        }
+    }
+    TlsSetValue(Key, NULL);
+#endif
+    return;
+}
+
+// /* Win32/64's struct TEB {} debuted as part of Day 1 of the "Win32 API".
+   // The Win32 API was created on July 27, 1993, the release date of WinNT 3.1.
+   // The WinNT 3.1 SDK, shares NOTHING, with the MS OS/2 SDKs.  There is zero src
+   // code compatibility.  All C functions, symbols, tokens, identifiers, macros,
+   // structs, were renamed or changed. Struct TEB has been officially
+   // undocumented, and is MS private API from 1993-2025 and counting.
+   // In 2001, as part of a legal settlement, MS released as public API, 
+   // in MSVC 2003, inside header winternl.h, a highly censored definition of
+   // struct TEB.
+
+   // Now, in reality, MS has never made an any efforts to keep struct TEB
+   // an actual secret.  MS's windbg.exe semi-TUI/REPL C debugger will easily
+   // give you "a", not "the", "a", full C struct definition of the TEB. That
+   // definition is *NOT* valid for any other machine, except your own, since
+   // its from the CRC32-matched dbg symbols for your exact .dll files (build #)
+   // sitting on your disk and in your proc's VA space.
+
+   // The TEB has been heavily documented and rev-engineered by the general public
+   // anyways, and all 3rd party C debugger/devel/diag/sysadmin tools know what
+   // the TEB is, and have a stable-enough definition of the TEB to do whatever
+   // they need to do, to accomplish their task.
+
+   // The TEB field, 32b OS at FS:[0x2C], and 64b OS at GS:[0x58] are public ABI.
+   // The 0x2C/0x58 offset is burned into all .exe/.dll files, as C lang TLS
+   // feature __declspec(thread). TEB offset 0x2C/0x58 is universal public ABI
+   // and works for all Windows CCs, MSVC and Mingw/GCC, and all OS versions,
+   // including WinNT 3.1-Win 11 and Win95-WinME.
+
+   // As mentioned in
+   // https://www.geoffchappell.com/studies/windows/km/ntoskrnl/inc/api/pebteb/teb/index.htm
+   // the TEB struct is de-facto public API, but not de-jure public API.
+   // MS will not entertain any "bug tickets" mentioning the TEB, that someone
+   // would file with MS using their Tier 1 Enterprise support/consulting
+   // contract.  Unsupported use, is unsupported.  UB is UB until added to a
+   // man page, and becomes "public API".
+
+   // Since the RT/dyn TLS slots are near the top of the TEB, and so old (years)
+   // by now, and documented in the very censored struct TEB{} inside winternl.h
+   // We can assume they will never ever change again in any future version of
+   // Windows, for the same CPU arch.
+   
+   // MS can only forklift-refactor or eliminate struct TEB {}, when adding
+   // a new CPU arch to WinNT. So far, year 2000+ WinNT implementsx86-32
+   // x86-32, IA64, x64/AMD64, ARM32, ARM64/AArch64.  The next possibility for
+   // MS to do a breaking change to the TEB, is adding Windows for RISC-V,
+   // or Windows for Loongson. Nothing else is on the horizon. Perl for WinOS
+   // would need a recompile plus patches for -V/-v/EU::MM to run *native* no-emul
+   // on those hypothetical future Win releases.
+
+   // In all likely hood, the TEB for a fictional Win on RISC-V/Loongson, will
+   // be identical to the x64/AMD64 TEB. Nothing changed in the TEB between
+   // Win/x64 and Win/ARM64. The CPU specific assembly code is abstracted away
+   // inside macro/fn call "NtCurrentTeb()". MSVC/Mingw CCs will update
+   // fn/macro NtCurrentTeb() as needed for any future ports to a new CPU arch.
+     // 1st struct member, has and will
+           // always be an inlined "struct NT_TIB" from MS's winnt.h */
+        // thr_keyv->TebOff1 = STRUCT_OFFSET(NT_TIB, Self);
+        // thr_keyv->TebOff2 = STRUCT_OFFSET(struct _TEB, TlsSlots) + (k*PTRSIZE);
+      // }
+      // else {
+        // thr_keyv->TebOff1 = STRUCT_OFFSET(struct _TEB, TlsExpansionSlots);
+        // thr_keyv->TebOff2 = (k-64)*PTRSIZE;
+      // }
+//}

win32/win32thread.h | 101 +++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 85 insertions(+), 16 deletions(-)

diff --git a/win32/win32thread.h b/win32/win32thread.h
index da5f229b22..cc438274b7 100644
--- a/win32/win32thread.h
+++ b/win32/win32thread.h
@@ -4,9 +4,40 @@
 #include "win32.h"
 
 typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond;
-typedef DWORD perl_key;
-typedef HANDLE perl_os_thread;
+//typedef DWORD perl_key;
+typedef void * (*PFN_GET_CXT)();
+typedef void * (*PFN_SET_CXT)(void *);
+typedef struct {
+    //PFN_GET_CXT pfnGetCxt;
+    //PFN_SET_CXT pfnSetCxt;
+    DWORD Key;
+    /* NOTE! Both USHORT vars, contain offsets in bytes, NOT array indexes!!!
+    The offsets are to the void *s or Size_ts we want to read.
+    Do not scale, shift, or pointer math these 2 offsets inside the
+    super-hot runtime Perl_set/get_context() macros or funcs.  This is an
+    optimization to avoid extra CPU ops, on ALL CPU archs, Intel/ARM/any-RISC.
+    On x86/x64, we are prevent extra LEA ops, or CC from using the super-big
+    "SIB byte" 1-3 more bytes scaler. ARM/RISC machine code will have its own
+    analog of x86 LEA, that will be optimized away if we use offsets, not idxs. */
+
+    //USHORT TebOff1; 
+    DWORD TebOff1; 
+    /* offset into the TEB, to the ptr field we want.
+    This ptr is a ptr to the array void*s. Trickery, so that Perl_get_context()
+    impl is branchless, and does not need to test and branch "if(key <= 64)".
+    We do trickery, for the original ancient TEB inline "key <= 64" slots, by
+    reading TEB* teb->Self member, which is the exact same ptr as
+    our var "TEB* teb". Now the ancient inline "key <= 64" slots, and the
+    >64 dynamic "add-on" slots, are both type "ptr to array of void *s" */
+    //USHORT TebOff2; 
+    DWORD TebOff2; 
+    /* offset into an array of void*, to Perl's TLS slot.*/
+} perl_key;
 
+#define W32_CINIT_THD_KEY {TLS_OUT_OF_INDEXES, 0, 0}
+
+typedef HANDLE perl_os_thread;
+void Perl_w32_study_tls(perl_key * thr_keyv);
 #ifndef DONT_USE_CRITICAL_SECTION
 
 /* Critical Sections used instead of mutexes: lightweight,
@@ -48,6 +79,8 @@ typedef HANDLE perl_mutex;
 
 #endif
 
+
+
 /* These macros assume that the mutex associated with the condition
  * will always be held before COND_{SIGNAL,BROADCAST,WAIT,DESTROY},
  * so there's no separate mutex protecting access to (c)->waiters
@@ -57,21 +90,21 @@ typedef HANDLE perl_mutex;
         (c)->waiters = 0;					\
         (c)->sem = Win_CreateSemaphore(NULL,0,LONG_MAX,NULL);	\
         if ((c)->sem == NULL)					\
-            Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError());	\
+            win32_panic_cond(W32PANIC_COND_INIT);	\
     } STMT_END
 
 #define COND_SIGNAL(c) \
     STMT_START {						\
         if ((c)->waiters > 0 &&					\
             ReleaseSemaphore((c)->sem,1,NULL) == 0)		\
-            Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError());	\
+            win32_panic_cndsig();	\
     } STMT_END
 
 #define COND_BROADCAST(c) \
     STMT_START {						\
         if ((c)->waiters > 0 &&					\
             ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0)	\
-            Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\
+            win32_panic_cond(W32PANIC_COND_BROADCAST);\
     } STMT_END
 
 #define COND_WAIT(c, m) \
@@ -82,7 +115,7 @@ typedef HANDLE perl_mutex;
          * COND_BROADCAST() on another thread will have seen the\
          * right number of waiters (i.e. including this one) */	\
         if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\
-            Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError());	\
+            win32_panic_cndwait();	\
         /* XXX there may be an inconsequential race here */	\
         MUTEX_LOCK(m);						\
         (c)->waiters--;						\
@@ -92,7 +125,7 @@ typedef HANDLE perl_mutex;
     STMT_START {						\
         (c)->waiters = 0;					\
         if (CloseHandle((c)->sem) == 0)				\
-            Perl_croak_nocontext("panic: COND_DESTROY (%ld)",GetLastError());	\
+            win32_panic_cond(W32PANIC_COND_DESTROY);	\
     } STMT_END
 
 #define DETACH(t) \
@@ -132,31 +165,67 @@ typedef HANDLE perl_mutex;
 typedef THREAD_RET_TYPE thread_func_t(void *);
 
 
-START_EXTERN_C
+
 
 #if defined(PERLDLL) && defined(USE_DECLSPEC_THREAD)
 extern __declspec(thread) void *PL_current_context;
 #define PERL_SET_CONTEXT(t)   		(PL_current_context = t)
 #define PERL_GET_CONTEXT		PL_current_context
 #else
+// #ifdef PERL_IN_PERL_C
+// void
+// Perl_w32_study_tls(void);
+// #endif
+
 #define PERL_GET_CONTEXT		Perl_get_context()
+//#define Perl_get_context (PL_thr_key.pfnGetCxt)
 #define PERL_SET_CONTEXT(t)		Perl_set_context(t)
+//#define Perl_set_context (PL_thr_key.pfnSetCxt)
+
+START_EXTERN_C
+
+/* Inside of perl5xx.dll (Core+any static XS) we directly call the fn ptr in
+   the global var as an optimization. The fn call is always 1 CPU op,
+   since the Win32 ABI/PE spec doesn't go through the DLL API/sym table API
+   if the deref is intra-binary.  But for XS dlls, they need to do 2-3 derefs,
+   b/c its a data var holding a fn ptr. So to restore "1 op"-ness of
+   Perl_S/G_Cxt for XS DLLs, they need a traditional PE-spec exported func.
+*/
+#ifdef PERLDLL
+
+#ifdef PERL_IN_WIN32THREAD_C
+DllExport PFN_GET_CXT Perl_get_context;
+DllExport PFN_SET_CXT Perl_set_context;
+#else
+extern DllExport const PFN_GET_CXT Perl_get_context;
+extern DllExport const PFN_SET_CXT Perl_set_context;
+#endif
+
+#else
+
+DllExport void *
+Perl_get_context(void);
+
+DllExport void
+Perl_set_context(void *t);
 #endif
 
 END_EXTERN_C
 
+#endif
+
+
+
 #define INIT_THREADS		NOOP
-#define ALLOC_THREAD_KEY \
-    STMT_START {							\
-        if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) {		\
-            PerlIO_printf(PerlIO_stderr(),"panic: TlsAlloc");				\
-            exit(1);							\
-        }								\
-    } STMT_END
+#define ALLOC_THREAD_KEY STMT_START { win32_alloc_tls(); } STMT_END
 
 #define FREE_THREAD_KEY \
     STMT_START {							\
-        TlsFree(PL_thr_key);						\
+        DWORD Key = PL_thr_key.Key; \
+        PL_thr_key.Key = TLS_OUT_OF_INDEXES; \
+        PL_thr_key.TebOff1 = 0; \
+        PL_thr_key.TebOff2 = 0; \
+        TlsFree(Key); \
     } STMT_END
 
 #define PTHREAD_ATFORK(prepare,parent,child)	NOOP