mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

de-layer Perlhost.h's 3 Malloc() classed + Cwd class

Browse Source 
-Perl's primary malloc pool (per interp, never ithread shared), doesnt
 need CS mutexes, the refcounting/multiple my_perl owners infrastruture,
 etc. Inline the IPerlMem/VPerLMem class/struct direct into CPerlHost
 class. Less ptr derefs at runtime. Saves memory, because no malloc header.
 And remove the 0x24 ??? bytes on x86-32 CS/mutex struct.
-Use retval of libc's memset(), saves a non-vol reg push/pop/saving cycle.
 ZeroMemory() has void retval. Lack of a Calloc() API in VMem.h is for
 another time.
-"virtual int Chdir(const char *dirname);" remove virtual tag. It is
 unused ptr indirection. Also the secret C++ vtable ptr im CPerlHost
 objs is now gone.
-inline VDir obj into CPerlHost, VDir *s are not shared between interps.
-Sort machine type integer members of CPerlHost class by size. Remove
 Alignment holes.
-Speedup  win32_checkTLS(), win32_checkTLS() is probably redundant
 outside -DDEBUGGING nowadays, it was added in commit

222c300afb1c8466398010a3403616462c302185  1/13/2002 10:37:48 AM
Win32 fixes:
 - vmem.h hack to handle free-by-wrong-thread after eval "".

still will leave it in for now, just optimize it instead.

I benchmarked, 10000x calls to Perl_get_context() in a loop.
Retval ignored, is 126 us (microsec). 10000x calls to
GetCurrentThreadId(), is 34 us.
This commit is contained in:
bulk88 2024-10-31 09:53:34 -04:00 committed by mauke
parent 48bda52b92
commit 650608f18d
7 changed files with 279 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
win32/perlhost.h
View File

@ -15,7 +15,13 @@
#include <signal.h>
#include <wchar.h>
#include "iperlsys.h"
#include "vmem.h"
#define CRT_ALLOC_BASE
#include "vmem.h"
#undef CRT_ALLOC_BASE
#include "vdir.h"
#ifndef WC_NO_BEST_FIT_CHARS
@ -38,6 +44,7 @@ public:
const struct IPerlProc** ppProc);
CPerlHost(CPerlHost& host);
~CPerlHost(void);
VMEM_H_NEW_OP;
static CPerlHost* IPerlMem2Host(const struct IPerlMem** piPerl);
static CPerlHost* IPerlMemShared2Host(const struct IPerlMem** piPerl);
@ -56,20 +63,20 @@ public:
/* IPerlMem */
/* Locks provided but should be unnecessary as this is private pool */
inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
inline void Free(void* ptr) { m_pVMem->Free(ptr); };
inline void* Malloc(size_t size) { return m_VMem.Malloc(size); };
inline void* Realloc(void* ptr, size_t size) { return m_VMem.Realloc(ptr, size); };
inline void Free(void* ptr) { m_VMem.Free(ptr); };
inline void* Calloc(size_t num, size_t size)
{
size_t count = num*size;
void* lpVoid = Malloc(count);
if (lpVoid)
ZeroMemory(lpVoid, count);
lpVoid = memset(lpVoid, 0, count);
return lpVoid;
};
inline void GetLock(void) { m_pVMem->GetLock(); };
inline void FreeLock(void) { m_pVMem->FreeLock(); };
inline int IsLocked(void) { return m_pVMem->IsLocked(); };
inline void GetLock(void) { m_VMem.GetLock(); };
inline void FreeLock(void) { m_VMem.FreeLock(); };
inline int IsLocked(void) { return m_VMem.IsLocked(); };
/* IPerlMemShared */
/* Locks used to serialize access to the pool */
@ -103,7 +110,7 @@ public:
size_t count = num*size;
void* lpVoid = MallocShared(count);
if (lpVoid)
ZeroMemory(lpVoid, count);
lpVoid = memset(lpVoid, 0, count);
return lpVoid;
};
@ -122,7 +129,7 @@ public:
size_t count = num*size;
void* lpVoid = MallocParse(count);
if (lpVoid)
ZeroMemory(lpVoid, count);
lpVoid = memset(lpVoid, 0, count);
return lpVoid;
};
@ -137,7 +144,7 @@ public:
*len = strlen(e);
return e;
}
void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(m_vDir); };
void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
char* GetChildDir(void);
void FreeChildDir(char* pStr);
@ -166,7 +173,7 @@ protected:
public:
/* IPerlDIR */
virtual int Chdir(const char *dirname);
int Chdir(const char *dirname);
/* IPerllProc */
void Abort(void);
@ -176,9 +183,10 @@ public:
int Execv(const char *cmdname, const char *const *argv);
int Execvp(const char *cmdname, const char *const *argv);
inline VMem* GetMem(void) { return (VMem* )&m_VMem; };
inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
inline VDir* GetDir(void) { return m_pvDir; };
inline VDir* GetDir(void) { return &m_vDir; };
public:
@ -192,22 +200,23 @@ public:
const struct IPerlSock* m_pHostperlSock;
const struct IPerlProc* m_pHostperlProc;
inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
inline char* MapPathA(const char *pInName) { return m_vDir.MapPathA(pInName); };
inline WCHAR* MapPathW(const WCHAR *pInName) { return m_vDir.MapPathW(pInName); };
inline operator VDir* () { return GetDir(); };
protected:
VDir* m_pvDir;
VMem* m_pVMem;
VMemNL m_VMem;
VMem* m_pVMemShared;
VMem* m_pVMemParse;
DWORD m_dwEnvCount;
LPSTR* m_lppEnvList;
DWORD m_dwEnvCount;
BOOL m_bTopLevel; // is this a toplevel host?
static long num_hosts;
public:
inline int LastHost(void) { return num_hosts == 1L; };
struct interpreter *host_perl;
protected:
VDir m_vDir;
};
long CPerlHost::num_hosts = 0L;
@ -2110,12 +2119,11 @@ CPerlHost::CPerlHost(void)
{
/* Construct a host from scratch */
InterlockedIncrement(&num_hosts);
m_pvDir = new VDir();
m_pVMem = new VMem();
m_pVMemShared = new VMem();
m_pVMemParse = new VMem();
m_pvDir->Init(NULL, m_pVMem);
m_vDir.Init(NULL);
m_dwEnvCount = 0;
m_lppEnvList = NULL;
@ -2150,12 +2158,11 @@ CPerlHost::CPerlHost(const struct IPerlMem** ppMem, const struct IPerlMem** ppMe
const struct IPerlProc** ppProc)
{
InterlockedIncrement(&num_hosts);
m_pvDir = new VDir(0);
m_pVMem = new VMem();
m_pVMemShared = new VMem();
m_pVMemParse = new VMem();
m_pvDir->Init(NULL, m_pVMem);
m_vDir.Init(NULL, 0);
m_dwEnvCount = 0;
m_lppEnvList = NULL;
@ -2177,13 +2184,12 @@ CPerlHost::CPerlHost(CPerlHost& host)
{
/* Construct a host from another host */
InterlockedIncrement(&num_hosts);
m_pVMem = new VMem();
m_pVMemShared = host.GetMemShared();
m_pVMemParse = host.GetMemParse();
/* duplicate directory info */
m_pvDir = new VDir(0);
m_pvDir->Init(host.GetDir(), m_pVMem);
m_vDir.Init(host.GetDir(), 0);
m_pHostperlMem = &perlMem;
m_pHostperlMemShared = &perlMemShared;
@ -2210,10 +2216,10 @@ CPerlHost::~CPerlHost(void)
{
Reset();
InterlockedDecrement(&num_hosts);
delete m_pvDir;
//delete m_vDir;
m_pVMemParse->Release();
m_pVMemShared->Release();
m_pVMem->Release();
//m_VMem.Release();
}
LPSTR
@ -2360,7 +2366,7 @@ CPerlHost::GetChildDir(void)
size_t length;
Newx(ptr, MAX_PATH+1, char);
m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
m_vDir.GetCurrentDirectoryA(MAX_PATH+1, ptr);
length = strlen(ptr);
if (length > 3) {
if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
@ -2546,11 +2552,19 @@ CPerlHost::Chdir(const char *dirname)
errno = ENOENT;
return -1;
}
ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
ret = m_vDir.SetCurrentDirectoryA((char*)dirname);
if(ret < 0) {
errno = ENOENT;
}
return ret;
}
static inline VMemNL * VDToVM(VDir * pvd) {
VDir * vd = (VDir *)pvd;
size_t p_szt = ((size_t)vd)-((size_t)((CPerlHost*)NULL)->GetDir());
CPerlHost * cph = (CPerlHost*)p_szt;
VMemNL * vm = cph->GetMem();
return vm;
}
#endif /* ___PerlHost_H___ */

19
win32/perllib.c
View File

@ -49,10 +49,21 @@ xs_init(pTHX)
void
win32_checkTLS(PerlInterpreter *host_perl)
{
dTHX;
if (host_perl != my_perl) {
int *nowhere = NULL;
abort();
/* GCurThdId() is lightweight, but b/c of the ctrl-c/signals sometimes firing
in other random WinOS threads, that make the TIDs go out of sync.
This isn't always an error, although high chance of a SEGV in the next
couple milliseconds b/c of "Day 1 of Win32 port" Ctrl-C vs Perl bugs.
Google it for details. So this code, if TIDs don't match, do the full heavy
TlsGetValue() + misc fn calls. Then resync TIDs to keep this fast for
future calls to this fn. */
DWORD tid = GetCurrentThreadId();
if(tid != host_perl->Isys_intern.cur_tid) {
dTHX; /* heavyweight */
if (host_perl != my_perl) {
int *nowhere = NULL;
abort();
}
host_perl->Isys_intern.cur_tid = tid;
}
}

49
win32/vdir.h
View File

@ -23,12 +23,15 @@ public:
VDir(int bManageDir = 1);
~VDir() {};
void Init(VDir* pDir, VMem *pMem);
VMEM_H_NEW_OP;
void Init(VDir* pDirCloneFrom);
void Init(VDir* pDirCloneFrom, int bManageDir);
void SetDefaultA(char const *pDefault);
void SetDefaultW(WCHAR const *pDefault);
char* MapPathA(const char *pInName);
WCHAR* MapPathW(const WCHAR *pInName);
int SetCurrentDirectoryA(char *lpBuffer);
/* CPerlHost::Chdir() is the only caller */
inline int SetCurrentDirectoryA(char *lpBuffer);
int SetCurrentDirectoryW(WCHAR *lpBuffer);
inline int GetDefault(void) { return nDefault; };
@ -116,36 +119,52 @@ protected:
return (chr | 0x20)-'a';
};
VMem *pMem;
int nDefault, bManageDirectory;
char *dirTableA[driveCount];
char szLocalBufferA[MAX_PATH+1];
/* Former "VMem *" member, just C-ptr-cast the VDir * to a CPerlHost *
and get the "VMem *" directly vs 2 copies of the ptr. */
#define pMem VDToVM(this)
WCHAR *dirTableW[driveCount];
char *dirTableA[driveCount];
int nDefault;
inline void * ZeroMemStart(void) {return (void *)dirTableW;};
inline size_t ZeroMemSize(void) {
return ((size_t)&nDefault)+sizeof(nDefault)-((size_t)dirTableW);
};
WCHAR szLocalBufferW[MAX_PATH+1];
char szLocalBufferA[MAX_PATH+1];
bool bManageDirectory;
};
static inline VMemNL * VDToVM(VDir * vd);
VDir::VDir(int bManageDir /* = 1 */)
{
nDefault = 0;
/* combine all fields needed Nulling into 1 call */
memset(ZeroMemStart(), 0, ZeroMemSize());
bManageDirectory = bManageDir;
memset(dirTableA, 0, sizeof(dirTableA));
memset(dirTableW, 0, sizeof(dirTableW));
}
void VDir::Init(VDir* pDir, VMem *p)
void VDir::Init(VDir* pDirCloneFrom, int bManageDir)
{
bManageDirectory = bManageDir;
VDir::Init(pDirCloneFrom);
}
void VDir::Init(VDir* pDirCloneFrom)
{
int index;
pMem = p;
if (pDir) {
if (pDirCloneFrom) {
for (index = 0; index < driveCount; ++index) {
SetDirW(pDir->GetDirW(index), index);
SetDirW(pDirCloneFrom->GetDirW(index), index);
}
nDefault = pDir->GetDefault();
nDefault = pDirCloneFrom->GetDefault();
}
else {
int bSave = bManageDirectory;
bool bSave = bManageDirectory;
DWORD driveBits = GetLogicalDrives();
bManageDirectory = 0;

198
win32/vmem.h
View File

@ -19,7 +19,7 @@
*/
#ifndef ___VMEM_H_INC___
#define ___VMEM_H_INC___
/* #define ___VMEM_H_INC___ */
#define _USE_MSVCRT_MEM_ALLOC
#define _USE_LINKED_LIST
@ -56,6 +56,36 @@ inline void MEMODSlx(char *str, long x)
#endif
/* Don't link in the static-linked object code into libperl.dll that
implements MSVC UCRT's C++ runtime exceptions and throw/catch/RTTI-ing them.
Even though perl links with ucrtbase.dll, there is alot of overhead for
using ::new() operator. Just implement our own ::new(), more C-style. */
#define VMEM_H_NEW_OP \
void* operator new(size_t size) noexcept { \
void * p = (void*)win32_malloc(size); \
if(!p) noperl_die("%s%s","Out of memory in perl:", "???"); return p; }; \
void* operator new[](size_t size) noexcept { \
void * p = (void*)win32_malloc(size); \
if(!p) noperl_die("%s%s","Out of memory in perl:", "???"); return p; }; \
void* operator new( size_t size, int block_use, \
char const* file_name, int line_number) noexcept { \
UNREFERENCED_PARAMETER(block_use); \
UNREFERENCED_PARAMETER(file_name); \
UNREFERENCED_PARAMETER(line_number); \
void * p = (void*)win32_malloc(size); \
if(!p) noperl_die("%s%s","Out of memory in perl:", "???"); return p; \
}; \
void* operator new[]( size_t size, int block_use, \
char const* file_name, int line_number) noexcept { \
UNREFERENCED_PARAMETER(block_use); \
UNREFERENCED_PARAMETER(file_name); \
UNREFERENCED_PARAMETER(line_number); \
void * p = (void*)win32_malloc(size); \
if(!p) noperl_die("%s%s","Out of memory in perl:", "???"); return p; }; \
void operator delete (void* p) noexcept { win32_free(p); return; }; \
void operator delete[] (void* p) noexcept { win32_free(p); return; }
#ifdef _USE_MSVCRT_MEM_ALLOC
#ifndef _USE_LINKED_LIST
@ -68,6 +98,7 @@ inline void MEMODSlx(char *str, long x)
*/
#ifdef _USE_LINKED_LIST
class VMemNL; /* NL = no locks */
class VMem;
/*
@ -87,7 +118,10 @@ typedef struct _MemoryBlockHeader* PMEMORY_BLOCK_HEADER;
typedef struct _MemoryBlockHeader {
PMEMORY_BLOCK_HEADER pNext;
PMEMORY_BLOCK_HEADER pPrev;
VMem *owner;
union {
VMemNL *owner_nl;
VMem *owner;
} u;
#if defined(__MINGW64__)
} MEMORY_BLOCK_HEADER __attribute__ ((aligned(16))), *PMEMORY_BLOCK_HEADER;
@ -97,11 +131,12 @@ typedef struct _MemoryBlockHeader {
#endif
class VMem
class VMemNL
{
public:
VMem();
~VMem();
VMemNL();
~VMemNL();
void* Malloc(size_t size);
void* Realloc(void* pMem, size_t size);
void Free(void* pMem);
@ -124,7 +159,7 @@ protected:
m_Dummy.pNext = ptr;
ptr->pPrev = &m_Dummy;
ptr->pNext = next;
ptr->owner = this;
ptr->u.owner_nl = this;
next->pPrev = ptr;
}
void UnlinkBlock(PMEMORY_BLOCK_HEADER ptr)
@ -136,41 +171,90 @@ protected:
}
MEMORY_BLOCK_HEADER m_Dummy;
#endif
}; /* class VMemNL */
class VMem : public VMemNL {
protected:
#ifdef _USE_LINKED_LIST
CRITICAL_SECTION m_cs; // access lock
#endif
volatile long m_lRefCount; // number of current users
long m_lRefCount; // number of current users
public:
VMem();
~VMem();
VMEM_H_NEW_OP;
void* Malloc(size_t size);
void* Realloc(void* pMem, size_t size);
void Free(void* pMem);
void GetLock(void);
void FreeLock(void);
inline int IsLocked(void);
long Release(void);
long AddRef(void);
};
VMem::VMem()
VMemNL::VMemNL(void)
{
#ifdef _USE_LINKED_LIST
m_Dummy.pNext = m_Dummy.pPrev = &m_Dummy;
m_Dummy.u.owner_nl = this;
#endif
return;
}
VMem::VMem(void)
{
m_lRefCount = 1;
#ifdef _USE_LINKED_LIST
InitializeCriticalSection(&m_cs);
m_Dummy.pNext = m_Dummy.pPrev = &m_Dummy;
m_Dummy.owner = this;
#endif _USE_LINKED_LIST
m_lRefCount = 1;
return;
}
VMemNL::~VMemNL(void)
{
#ifdef _USE_LINKED_LIST
while (m_Dummy.pNext != &m_Dummy) {
Free(m_Dummy.pNext+1);
}
#endif
}
VMem::~VMem(void)
{
#ifdef _USE_LINKED_LIST
while (m_Dummy.pNext != &m_Dummy) {
Free(m_Dummy.pNext+1);
}
DeleteCriticalSection(&m_cs);
#endif
}
#endif /* _USE_MSVCRT_MEM_ALLOC */
void* VMem::Malloc(size_t size)
#endif /* ___VMEM_H_INC___ */
/* #include "vmem.h" a 2nd time for Malloc()/Free() defs for VMem locking class */
#if defined(___VMEM_H_INC___) && defined(_USE_MSVCRT_MEM_ALLOC) && defined(CRT_ALLOC_BASE)
#define VMemNL VMem
#undef CRT_ALLOC_BASE
#endif
#ifdef _USE_MSVCRT_MEM_ALLOC
void* VMemNL::Malloc(size_t size)
{
#ifdef _USE_LINKED_LIST
GetLock();
PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)malloc(size+sizeof(MEMORY_BLOCK_HEADER));
if (!ptr) {
FreeLock();
return NULL;
}
GetLock();
LinkBlock(ptr);
FreeLock();
return (ptr+1);
@ -179,7 +263,7 @@ void* VMem::Malloc(size_t size)
#endif
}
void* VMem::Realloc(void* pMem, size_t size)
void* VMemNL::Realloc(void* pMem, size_t size)
{
#ifdef _USE_LINKED_LIST
if (!pMem)
@ -190,8 +274,8 @@ void* VMem::Realloc(void* pMem, size_t size)
return NULL;
}
GetLock();
PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER));
GetLock();
UnlinkBlock(ptr);
ptr = (PMEMORY_BLOCK_HEADER)realloc(ptr, size+sizeof(MEMORY_BLOCK_HEADER));
if (!ptr) {
@ -207,35 +291,82 @@ void* VMem::Realloc(void* pMem, size_t size)
#endif
}
void VMem::Free(void* pMem)
void VMemNL::Free(void* pMem)
{
#ifdef _USE_LINKED_LIST
if (pMem) {
PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER));
if (ptr->owner != this) {
if (ptr->owner) {
if (ptr->u.owner_nl != this) {
if (ptr->u.owner_nl) {
#if 1
int *nowhere = NULL;
Perl_warn_nocontext("Free to wrong pool %p not %p",this,ptr->owner);
Perl_warn_nocontext("Free to wrong pool %p not %p",this,ptr->u.owner_nl);
*nowhere = 0; /* this segfault is deliberate,
so you can see the stack trace */
#else
ptr->owner->Free(pMem);
ptr->u.owner_nl->Free(pMem);
#endif
}
return;
}
GetLock();
UnlinkBlock(ptr);
ptr->owner = NULL;
free(ptr);
FreeLock();
/* rev 222c300afb1c8466398010a3403616462c302185
1/13/2002 10:37:48 AM
Win32 fixes-vmem.h hack to handle free-by-wrong-thread after eval "".
*/
/* paranoia from 2002 mostly, but still a very small debugging aid today.
poisoning ->owner field, stops dead cold, MS OS Heap API' Free pool
from reissue new blocks, with "faux initialzed" "almost legit"
looking Perl wrapper headers but infact that ARE 100%
uninit/dealloced/random data, its not aleak to chase!!!! its uninit data!!!
*/
ptr->u.owner_nl = NULL;
free(ptr);
}
#else /*_USE_LINKED_LIST*/
free(pMem);
#endif
}
#endif
#undef VMemNL
#ifndef ___VMEM_H_INC___
#ifdef _USE_MSVCRT_MEM_ALLOC
void VMemNL::GetLock(void)
{
return;
}
void VMemNL::FreeLock(void)
{
return;
}
int VMemNL::IsLocked(void)
{
abort();
ASSERT(0); /* alarm bells for when somebody calls this */
return 0;
}
long VMemNL::Release(void)
{
abort();
}
long VMemNL::AddRef(void)
{
abort();
}
void VMem::GetLock(void)
{
#ifdef _USE_LINKED_LIST
@ -270,8 +401,10 @@ int VMem::IsLocked(void)
long VMem::Release(void)
{
long lCount = InterlockedDecrement(&m_lRefCount);
if(!lCount)
if(!lCount) {
delete this;
return 0;
}
return lCount;
}
@ -419,12 +552,13 @@ class VMem
public:
VMem();
~VMem();
VMEM_H_NEW_OP;
void* Malloc(size_t size);
void* Realloc(void* pMem, size_t size);
void Free(void* pMem);
void GetLock(void);
void FreeLock(void);
int IsLocked(void);
inline int IsLocked(void);
long Release(void);
long AddRef(void);
@ -508,7 +642,6 @@ protected:
VMem::VMem()
{
m_lRefCount = 1;
#ifndef _USE_BUDDY_BLOCKS
BOOL bRet = (NULL != (m_hHeap = HeapCreate(HEAP_NO_SERIALIZE,
lAllocStart, /* initial size of heap */
@ -520,6 +653,7 @@ VMem::VMem()
#ifdef _DEBUG_MEM
m_pLog = 0;
#endif
m_lRefCount = 1;
Init();
}
@ -916,8 +1050,10 @@ int VMem::IsLocked(void)
long VMem::Release(void)
{
long lCount = InterlockedDecrement(&m_lRefCount);
if(!lCount)
if(!lCount) {
delete this;
return 0;
}
return lCount;
}
@ -1262,4 +1398,6 @@ void VMem::WalkHeap(int complete)
#endif /* _USE_MSVCRT_MEM_ALLOC */
#define ___VMEM_H_INC___
#endif /* ___VMEM_H_INC___ */

13
win32/win32.c
View File

@ -5696,7 +5696,8 @@ Perl_sys_intern_init(pTHX)
w32_pseudo_id = 0;
Newx(w32_pseudo_children, 1, pseudo_child_tab);
w32_num_pseudo_children = 0;
# endif
PL_sys_intern.cur_tid = GetCurrentThreadId();
#endif
w32_timerid = 0;
w32_message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE);
w32_poll_count = 0;
@ -5739,6 +5740,15 @@ Perl_sys_intern_clear(pTHX)
}
if (w32_message_hwnd != NULL && w32_message_hwnd != INVALID_HANDLE_VALUE)
DestroyWindow(w32_message_hwnd);
/* "win32_checkTLS()" executes very late in perl_destruct() and/or perl_free().
Field cur_tid must be working to the very end of the
interp struct/mem alloc/process.
#ifdef USE_ITHREADS
PL_sys_intern.cur_tid = 0;
#endif
*/
# ifdef MULTIPLICITY
if (my_perl == PL_curinterp) {
# else
@ -5764,6 +5774,7 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
dst->fdpid = newAV();
Newxz(dst->children, 1, child_tab);
dst->pseudo_id = 0;
dst->cur_tid = 0;
Newxz(dst->pseudo_children, 1, pseudo_child_tab);
dst->timerid = 0;
dst->message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE);

3
win32/win32.h
View File

@ -523,6 +523,9 @@ struct interp_intern {
HWND message_hwnd;
UINT timerid;
unsigned poll_count;
#ifdef USE_ITHREADS
DWORD cur_tid;
#endif
Sighandler_t sigtable[SIG_SIZE];
};

2
win32/win32thread.c
View File

@ -17,6 +17,8 @@ Perl_set_context(void *t)
TlsSetValue(PL_thr_key,t);
SetLastError(err);
# endif
dTHXa(t);
PL_sys_intern.cur_tid = GetCurrentThreadId();
#endif
}