This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make debugging easier in memory allocator code in perl.c and util.c
authorDaniel Dragan <bulk88@hotmail.com>
Tue, 20 May 2014 07:23:01 +0000 (03:23 -0400)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 15 Nov 2014 14:57:53 +0000 (06:57 -0800)
-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

perl.c
util.c

diff --git a/perl.c b/perl.c
index a5f1592..eb875fc 100644 (file)
--- 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 (file)
--- 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
     }
 }