Change 33388: Do the memory debug header fixup earlier to avoid valgrind screaming

[Nicholas Clark]

Change 33388 by [EMAIL PROTECTED] on 2008/02/27 16:45:20

        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.

Affected files ...

... //depot/perl/perl.c#863 edit
... //depot/perl/util.c#651 edit

Differences ...

==== //depot/perl/perl.c#863 (text) ====
Index: perl/perl.c
--- perl/perl.c#862~33376~      2008-02-26 05:13:18.000000000 -0800
+++ perl/perl.c 2008-02-27 08:45:20.000000000 -0800
@@ -1376,10 +1376,17 @@
         */
        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

==== //depot/perl/util.c#651 (text) ====
Index: perl/util.c
--- perl/util.c#650~33376~      2008-02-26 05:13:18.000000000 -0800
+++ perl/util.c 2008-02-27 08:45:20.000000000 -0800
@@ -178,11 +178,11 @@
     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 @@
        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)
End of Patch.