From: Nick Ing-Simmons Date: Sun, 13 Jan 2002 15:37:48 +0000 (+0000) Subject: Win32 fixes: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=222c300afb1c8466398010a3403616462c302185;p=p5sagit%2Fp5-mst-13.2.git Win32 fixes: - vmem.h hack to handle free-by-wrong-thread after eval "". - Initialize timerid p4raw-id: //depot/perlio@14232 --- diff --git a/win32/perlhost.h b/win32/perlhost.h index 3be76ed..7a6fc43 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -7,6 +7,8 @@ * License or the Artistic License, as specified in the README file. */ +#define CHECK_HOST_INTERP + #ifndef ___PerlHost_H___ #define ___PerlHost_H___ @@ -214,16 +216,30 @@ protected: static long num_hosts; public: inline int LastHost(void) { return num_hosts == 1L; }; +#ifdef CHECK_HOST_INTERP + struct interpreter *host_perl; +#endif }; long CPerlHost::num_hosts = 0L; +extern "C" void win32_checkTLS(struct interpreter *host_perl); -#define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y)) +#define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y)) +#ifdef CHECK_HOST_INTERP +inline CPerlHost* CheckInterp(CPerlHost *host) +{ + win32_checkTLS(host->host_perl); + return host; +} +#define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y)) +#else +#define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y) +#endif inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl) { - return STRUCT2PTR(piPerl, m_hostperlMem); + return STRUCT2RAWPTR(piPerl, m_hostperlMem); } inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl) @@ -1681,6 +1697,7 @@ win32_start_child(LPVOID arg) PERL_SET_THX(my_perl); + win32_checkTLS(my_perl); /* set $$ to pseudo id */ #ifdef PERL_SYNC_FORK @@ -1747,9 +1764,11 @@ restart: JMPENV_POP; /* XXX hack to avoid perl_destruct() freeing optree */ + win32_checkTLS(my_perl); PL_main_root = Nullop; } + win32_checkTLS(my_perl); /* close the std handles to avoid fd leaks */ { do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE); @@ -1758,7 +1777,9 @@ restart: } /* destroy everything (waits for any pseudo-forked children) */ + win32_checkTLS(my_perl); perl_destruct(my_perl); + win32_checkTLS(my_perl); perl_free(my_perl); #ifdef PERL_SYNC_FORK @@ -1795,6 +1816,7 @@ PerlProcFork(struct IPerlProc* piPerl) h->m_pHostperlProc ); new_perl->Isys_intern.internal_host = h; + h->host_perl = new_perl; # ifdef PERL_SYNC_FORK id = win32_start_child((LPVOID)new_perl); PERL_SET_THX(aTHX); @@ -2414,3 +2436,4 @@ CPerlHost::Chdir(const char *dirname) } #endif /* ___PerlHost_H___ */ + diff --git a/win32/perllib.c b/win32/perllib.c index 6243a79..4e4c113 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -33,6 +33,17 @@ xs_init(pTHX) #include "perlhost.h" +void +win32_checkTLS(PerlInterpreter *host_perl) +{ + dTHX; + if (host_perl != my_perl) { + int *nowhere = NULL; + *nowhere = 0; + abort(); + } +} + EXTERN_C void perl_get_host_info(struct IPerlMemInfo* perlMemInfo, struct IPerlMemInfo* perlMemSharedInfo, @@ -105,6 +116,7 @@ perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, pHost->m_pHostperlProc); if (my_perl) { w32_internal_host = pHost; + pHost->host_perl = my_perl; } } return my_perl; @@ -127,6 +139,7 @@ perl_alloc(void) pHost->m_pHostperlProc); if (my_perl) { w32_internal_host = pHost; + pHost->host_perl = my_perl; } } return my_perl; @@ -287,6 +300,7 @@ perl_clone_host(PerlInterpreter* proto_perl, UV flags) { h->m_pHostperlProc ); proto_perl->Isys_intern.internal_host = h; + h->host_perl = proto_perl; return proto_perl; } diff --git a/win32/vmem.h b/win32/vmem.h index cda6f81..a60459d 100644 --- a/win32/vmem.h +++ b/win32/vmem.h @@ -21,7 +21,8 @@ #ifndef ___VMEM_H_INC___ #define ___VMEM_H_INC___ -// #define _USE_MSVCRT_MEM_ALLOC +#define _USE_MSVCRT_MEM_ALLOC +#define _USE_LINKED_LIST // #define _USE_BUDDY_BLOCKS @@ -70,10 +71,12 @@ typedef void (*LPFREE)(void *block); typedef void* (*LPMALLOC)(size_t size); typedef void* (*LPREALLOC)(void *block, size_t size); #ifdef _USE_LINKED_LIST +class VMem; typedef struct _MemoryBlockHeader* PMEMORY_BLOCK_HEADER; typedef struct _MemoryBlockHeader { PMEMORY_BLOCK_HEADER pNext; PMEMORY_BLOCK_HEADER pPrev; + VMem *owner; } MEMORY_BLOCK_HEADER, *PMEMORY_BLOCK_HEADER; #endif @@ -104,6 +107,7 @@ protected: m_Dummy.pNext = ptr; ptr->pPrev = &m_Dummy; ptr->pNext = next; + ptr->owner = this; next->pPrev = ptr; } void UnlinkBlock(PMEMORY_BLOCK_HEADER ptr) @@ -131,6 +135,7 @@ VMem::VMem() InitializeCriticalSection(&m_cs); #ifdef _USE_LINKED_LIST m_Dummy.pNext = m_Dummy.pPrev = &m_Dummy; + m_Dummy.owner = this; #endif m_hLib = LoadLibrary("msvcrt.dll"); if (m_hLib) { @@ -155,8 +160,10 @@ VMem::~VMem(void) void* VMem::Malloc(size_t size) { #ifdef _USE_LINKED_LIST + GetLock(); PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)m_pmalloc(size+sizeof(MEMORY_BLOCK_HEADER)); LinkBlock(ptr); + FreeLock(); return (ptr+1); #else return m_pmalloc(size); @@ -174,10 +181,12 @@ void* VMem::Realloc(void* pMem, size_t size) return NULL; } + GetLock(); PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER)); UnlinkBlock(ptr); ptr = (PMEMORY_BLOCK_HEADER)m_prealloc(ptr, size+sizeof(MEMORY_BLOCK_HEADER)); LinkBlock(ptr); + FreeLock(); return (ptr+1); #else @@ -190,8 +199,22 @@ void VMem::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 0 + int *nowhere = NULL; + *nowhere = 0; +#else + if (ptr->owner) { + ptr->owner->Free(pMem); + } + return; +#endif + } + GetLock(); UnlinkBlock(ptr); + ptr->owner = NULL; m_pfree(ptr); + FreeLock(); } #else m_pfree(pMem); diff --git a/win32/win32.c b/win32/win32.c index 7df339d..246c0c8 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1722,7 +1722,7 @@ win32_async_check(pTHX) /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages * and ignores window messages - should co-exist better with windows apps e.g. Tk */ - while (PeekMessage(&msg, (HWND)-1, 0, 0, PM_REMOVE)) { + while (PeekMessage(&msg, (HWND)-1, 0, 0, PM_REMOVE|PM_NOYIELD)) { switch(msg.message) { #if 0 @@ -1742,8 +1742,10 @@ win32_async_check(pTHX) case WM_TIMER: { /* alarm() is a one-shot but SetTimer() repeats so kill it */ - KillTimer(NULL,w32_timerid); - w32_timerid=0; + if (w32_timerid) { + KillTimer(NULL,w32_timerid); + w32_timerid=0; + } /* Now fake a call to signal handler */ CALL_FPTR(PL_sighandlerp)(14); break; @@ -4558,6 +4560,7 @@ Perl_sys_intern_init(pTHX) w32_num_pseudo_children = 0; # endif w32_init_socktype = 0; + w32_timerid = 0; if (my_perl == PL_curinterp) { /* Force C runtime signal stuff to set its console handler */ signal(SIGINT,&win32_csighandler); @@ -4574,6 +4577,10 @@ Perl_sys_intern_clear(pTHX) Safefree(w32_perlshell_vec); /* NOTE: w32_fdpid is freed by sv_clean_all() */ Safefree(w32_children); + if (w32_timerid) { + KillTimer(NULL,w32_timerid); + w32_timerid=0; + } if (my_perl == PL_curinterp) { SetConsoleCtrlHandler(win32_ctrlhandler,FALSE); } @@ -4595,6 +4602,7 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) dst->pseudo_id = 0; Newz(1313, dst->pseudo_children, 1, child_tab); dst->thr_intern.Winit_socktype = 0; + dst->timerid = 0; } # endif /* USE_ITHREADS */ #endif /* HAVE_INTERP_INTERN */