From: Daniel Dragan <bulk88@hotmail.com>
Date: Tue, 20 May 2014 07:23:01 +0000 (-0400)
Subject: make debugging easier in memory allocator code in perl.c and util.c
X-Git-Tag: v5.21.6~89
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/6edcbed6404ee551719c9a49397baea538aae7cc?hp=1f9498d0e14a8f9d5a95c29b732bb33bb3c669d8;ds=sidebyside

make debugging easier in memory allocator code in perl.c and util.c

-show intermediate values to make C debugging easier
-Perl_safesysfree overwrote var where with a different value, this caused
 alot of confusion for me of trying to hunt for a pointer from a stack
 trace with conditional breakpoints, so don't change var where in an
 unoptimized build
-in Perl_safesysrealloc and Perl_safesysmalloc provide 1 exit path, so
 the returned value is easily seen and BPed on unoptimized builds
---

diff --git a/perl.c b/perl.c
index a5f1592..eb875fc 100644
--- a/perl.c
+++ b/perl.c
@@ -1364,8 +1364,11 @@ perl_free(pTHXx)
 			    "free this thread's memory\n");
 		PL_debug &= ~ DEBUG_m_FLAG;
 	    }
-	    while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
-		safesysfree(PERL_MEMORY_DEBUG_HEADER_SIZE + (char *)(aTHXx->Imemory_debug_header.next));
+	    while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header)){
+		char * next = (char *)(aTHXx->Imemory_debug_header.next);
+		Malloc_t ptr = PERL_MEMORY_DEBUG_HEADER_SIZE + next;
+		safesysfree(ptr);
+	    }
 	    PL_debug = old_debug;
 	}
     }
diff --git a/util.c b/util.c
index f9ca306..4ee17c2 100644
--- a/util.c
+++ b/util.c
@@ -172,14 +172,17 @@ Perl_safesysmalloc(MEM_SIZE size)
 #endif
         ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE);
 	DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
+	ret:
 	return ptr;
 }
     else {
 #ifndef ALWAYS_NEED_THX
 	dTHX;
 #endif
-	if (PL_nomemok)
-	    return NULL;
+	if (PL_nomemok){
+	    ptr = NULL;
+	    goto ret;
+	}
 	else {
 	    croak_no_mem();
 	}
@@ -207,11 +210,14 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 
     if (!size) {
 	safesysfree(where);
-	return NULL;
+	ptr = NULL;
+	goto ret;
     }
 
-    if (!where)
-	return safesysmalloc(size);
+    if (!where) {
+	ptr = safesysmalloc(size);
+	goto ret;
+    }
 #ifdef USE_MDH
     where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE);
     size += PERL_MEMORY_DEBUG_HEADER_SIZE;
@@ -293,14 +299,17 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 
 
     if (ptr != NULL) {
+	ret:
 	return ptr;
     }
     else {
 #ifndef ALWAYS_NEED_THX
 	dTHX;
 #endif
-	if (PL_nomemok)
-	    return NULL;
+	if (PL_nomemok){
+	    ptr = NULL;
+	    goto ret;
+	}
 	else {
 	    croak_no_mem();
 	}
@@ -319,10 +328,10 @@ Perl_safesysfree(Malloc_t where)
     DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++));
     if (where) {
 #ifdef USE_MDH
-        where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE);
+	Malloc_t where_intrn = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE);
 	{
 	    struct perl_memory_debug_header *const header
-		= (struct perl_memory_debug_header *)where;
+		= (struct perl_memory_debug_header *)where_intrn;
 
 # ifdef MDH_HAS_SIZE
 	    const MEM_SIZE size = header->size;
@@ -352,21 +361,23 @@ Perl_safesysfree(Malloc_t where)
 	    maybe_protect_ro(header->prev);
 	    maybe_protect_rw(header);
 #  ifdef PERL_POISON
-	    PoisonNew(where, size, char);
+	    PoisonNew(where_intrn, size, char);
 #  endif
 	    /* Trigger the duplicate free warning.  */
 	    header->next = NULL;
 # endif
 # ifdef PERL_DEBUG_READONLY_COW
-	    if (munmap(where, size)) {
+	    if (munmap(where_intrn, size)) {
 		perror("munmap failed");
 		abort();
 	    }	
 # endif
 	}
-#endif
+#else
+	Malloc_t where_intrn = where;
+#endif /* USE_MDH */
 #ifndef PERL_DEBUG_READONLY_COW
-	PerlMem_free(where);
+	PerlMem_free(where_intrn);
 #endif
     }
 }