This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl -d: add a test for s EXPR().
[perl5.git] / win32 / vmem.h
index cda6f81..460f557 100644 (file)
 #ifndef ___VMEM_H_INC___
 #define ___VMEM_H_INC___
 
-// #define _USE_MSVCRT_MEM_ALLOC
+#ifndef UNDER_CE
+#define _USE_MSVCRT_MEM_ALLOC
+#endif
+#define _USE_LINKED_LIST
 
 // #define _USE_BUDDY_BLOCKS
 
@@ -70,10 +73,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 +109,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 +137,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 +162,14 @@ 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));
+    if (!ptr) {
+       FreeLock();
+       return NULL;
+    }
     LinkBlock(ptr);
+    FreeLock();
     return (ptr+1);
 #else
     return m_pmalloc(size);
@@ -174,10 +187,16 @@ 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));
+    if (!ptr) {
+       FreeLock();
+       return NULL;
+    }
     LinkBlock(ptr);
+    FreeLock();
 
     return (ptr+1);
 #else
@@ -190,8 +209,25 @@ 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 (ptr->owner) {
+#if 1
+               dTHX;
+               int *nowhere = NULL;
+               Perl_warn(aTHX_ "Free to wrong pool %p not %p",this,ptr->owner);
+               *nowhere = 0; /* this segfault is deliberate, 
+                                so you can see the stack trace */
+#else
+                ptr->owner->Free(pMem);        
+#endif
+           }
+           return;
+        }
+       GetLock();
        UnlinkBlock(ptr);
+       ptr->owner = NULL;
        m_pfree(ptr);
+       FreeLock();
     }
 #else
     m_pfree(pMem);
@@ -1009,7 +1045,7 @@ int VMem::HeapAdd(void* p, size_t size
            if(ptr == m_heaps[index].base + (int)m_heaps[index].len) {
                /*
                 * The new block is contiguous with a previously allocated heap area.  Add its
-                * length to that of the previous heap.  Merge it with the the dummy end-of-heap
+                * length to that of the previous heap.  Merge it with the dummy end-of-heap
                 * area marker of the previous heap.
                 */
                m_heaps[index].len += size;