Change 14235 by jhi@alpha on 2002/01/13 16:45:52
Integrate perlio;
Win32 fixes:
- vmem.h hack to handle free-by-wrong-thread after eval "".
- Initialize timerid
Affected files ...
.... //depot/perl/win32/perlhost.h#48 integrate
.... //depot/perl/win32/perllib.c#50 integrate
.... //depot/perl/win32/vmem.h#7 integrate
.... //depot/perl/win32/win32.c#186 integrate
Differences ...
==== //depot/perl/win32/perlhost.h#48 (text) ====
Index: perl/win32/perlhost.h
--- perl/win32/perlhost.h.~1~ Sun Jan 13 10:00:05 2002
+++ perl/win32/perlhost.h Sun Jan 13 10:00:05 2002
@@ -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 @@
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 @@
PERL_SET_THX(my_perl);
+ win32_checkTLS(my_perl);
/* set $$ to pseudo id */
#ifdef PERL_SYNC_FORK
@@ -1747,9 +1764,11 @@
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 @@
}
/* 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 @@
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 @@
}
#endif /* ___PerlHost_H___ */
+
==== //depot/perl/win32/perllib.c#50 (text) ====
Index: perl/win32/perllib.c
--- perl/win32/perllib.c.~1~ Sun Jan 13 10:00:05 2002
+++ perl/win32/perllib.c Sun Jan 13 10:00:05 2002
@@ -33,6 +33,17 @@
#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 @@
pHost->m_pHostperlProc);
if (my_perl) {
w32_internal_host = pHost;
+ pHost->host_perl = my_perl;
}
}
return my_perl;
@@ -127,6 +139,7 @@
pHost->m_pHostperlProc);
if (my_perl) {
w32_internal_host = pHost;
+ pHost->host_perl = my_perl;
}
}
return my_perl;
@@ -287,6 +300,7 @@
h->m_pHostperlProc
);
proto_perl->Isys_intern.internal_host = h;
+ h->host_perl = proto_perl;
return proto_perl;
}
==== //depot/perl/win32/vmem.h#7 (text) ====
Index: perl/win32/vmem.h
--- perl/win32/vmem.h.~1~ Sun Jan 13 10:00:05 2002
+++ perl/win32/vmem.h Sun Jan 13 10:00:05 2002
@@ -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* (*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 @@
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 @@
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 @@
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 @@
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 @@
#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);
==== //depot/perl/win32/win32.c#186 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c.~1~ Sun Jan 13 10:00:05 2002
+++ perl/win32/win32.c Sun Jan 13 10:00:05 2002
@@ -1722,7 +1722,7 @@
/* 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 @@
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 @@
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 @@
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 @@
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 */
End of Patch.
