Skip to content

Commit

Permalink
make debugging easier in memory allocator code in perl.c and util.c
Browse files Browse the repository at this point in the history
-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
  • Loading branch information
bulk88 authored and Father Chrysostomos committed Nov 15, 2014
1 parent 1f9498d commit 6edcbed
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 15 deletions.
7 changes: 5 additions & 2 deletions perl.c
Expand Up @@ -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;
}
}
Expand Down
37 changes: 24 additions & 13 deletions util.c
Expand Up @@ -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();
}
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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();
}
Expand All @@ -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;
Expand Down Expand Up @@ -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
}
}
Expand Down

0 comments on commit 6edcbed

Please sign in to comment.