From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 27 Feb 2008 16:45:20 +0000 (+0000)
Subject: Do the memory debug header fixup earlier to avoid valgrind screaming
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4fd0a9b8690ace1bad89926e6d018a6f863761c3;p=p5sagit%2Fp5-mst-13.2.git

Do the memory debug header fixup earlier to avoid valgrind screaming
under -Dm. Also, temporarily disable memory logging during thread
memory freeing, as otherwise we try to log using memory we already
freed.

p4raw-id: //depot/perl@33388
---

diff --git a/perl.c b/perl.c
index 5680f29..a7f6ab5 100644
--- a/perl.c
+++ b/perl.c
@@ -1376,10 +1376,17 @@ perl_free(pTHXx)
 	 */
 	const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
 	if (!s || atoi(s) == 0) {
+	    const U32 old_debug = PL_debug;
 	    /* Emulate the PerlHost behaviour of free()ing all memory allocated in this
 	       thread at thread exit.  */
+	    if (DEBUG_m_TEST) {
+		PerlIO_puts(Perl_debug_log, "Disabling memory debugging as we "
+			    "free this thread's memory\n");
+		PL_debug &= ~ DEBUG_m_FLAG;
+	    }
 	    while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
 		safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
+	    PL_debug = old_debug;
 	}
     }
 #endif
diff --git a/util.c b/util.c
index 37e913e..36166fb 100644
--- a/util.c
+++ b/util.c
@@ -178,11 +178,11 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
     ptr = (Malloc_t)PerlMem_realloc(where,size);
     PERL_ALLOC_CHECK(ptr);
 
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
-
-    if (ptr != NULL) {
+    /* MUST do this fixup first, before doing ANYTHING else, as anything else
+       might allocate memory/free/move memory, and until we do the fixup, it
+       may well be chasing (and writing to) free memory.  */
 #ifdef PERL_TRACK_MEMPOOL
+    if (ptr != NULL) {
 	struct perl_memory_debug_header *const header
 	    = (struct perl_memory_debug_header *)ptr;
 
@@ -198,7 +198,17 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 	header->prev->next = header;
 
         ptr = (Malloc_t)((char*)ptr+sTHX);
+    }
 #endif
+
+    /* In particular, must do that fixup above before logging anything via
+     *printf(), as it can reallocate memory, which can cause SEGVs.  */
+
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
+
+
+    if (ptr != NULL) {
 	return ptr;
     }
     else if (PL_nomemok)