If PERL_TRACK_MEMPOOL and PERL_POISON are in use, then scribble all

over memory to invalidate it just before free()ing it.

p4raw-id: //depot/perl@26476

diff --git a/perl.h b/perl.h
index b314184..f478c22 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -138,8 +138,6 @@
 
 #define pVAR    register struct perl_vars* my_vars PERL_UNUSED_DECL
 
-typedef struct interpreter PerlInterpreter;
-
 #ifdef PERL_GLOBAL_STRUCT
 #  define dVAR         pVAR    = (struct perl_vars*)PERL_GET_VARS()
 #else
@@ -151,14 +149,6 @@ typedef struct interpreter PerlInterpreter;
 #    define MULTIPLICITY
 #  endif
 #  define tTHX PerlInterpreter*
-
-struct perl_memory_debug_header {
-  tTHX interpreter;
-};
-
-#  define sTHX (sizeof(struct perl_memory_debug_header) + \
-       (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
-        %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
 #  define pTHX register tTHX my_perl PERL_UNUSED_DECL
 #  define aTHX my_perl
 #  ifdef PERL_GLOBAL_STRUCT
@@ -2164,6 +2154,8 @@ typedef struct padop PADOP;
 typedef struct pvop PVOP;
 typedef struct loop LOOP;
 
+typedef struct interpreter PerlInterpreter;
+
 /* Amdahl's <ksync.h> has struct sv */
 /* SGI's <sys/sema.h> has struct sv */
 #if defined(UTS) || defined(__sgi)
@@ -3734,6 +3726,24 @@ typedef Sighandler_t Sigsave_t;
 #  define MALLOC_TERM
 #endif
 
+#if defined(PERL_IMPLICIT_CONTEXT)
+struct perl_memory_debug_header {
+  tTHX interpreter;
+#  ifdef PERL_POISON
+  MEM_SIZE size;
+  U8 in_use;
+#  endif
+
+#define PERL_POISON_INUSE 29
+#define PERL_POISON_FREE 159
+};
+
+#  define sTHX (sizeof(struct perl_memory_debug_header) + \
+       (MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
+        %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
+
+#endif
+
 
 typedef int (CPERLscope(*runops_proc_t)) (pTHX);
 typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);

diff --git a/util.c b/util.c
index 34bf4bb..c9e4446 100644 (file)
--- a/util.c
+++ b/util.c
@@ -94,6 +94,10 @@ Perl_safesysmalloc(MEM_SIZE size)
     if (ptr != Nullch) {
 #ifdef PERL_TRACK_MEMPOOL
         ((struct perl_memory_debug_header *)ptr)->interpreter = aTHX;
+#  ifdef PERL_POISON
+        ((struct perl_memory_debug_header *)ptr)->size = size;
+        ((struct perl_memory_debug_header *)ptr)->in_use = PERL_POISON_INUSE;
+#  endif
         ptr = (Malloc_t)((char*)ptr+sTHX);
 #endif
        return ptr;
@@ -138,6 +142,10 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
        /* int *nowhere = NULL; *nowhere = 0; */
         Perl_croak_nocontext("panic: realloc from wrong pool");
     }
+#  ifdef PERL_POISON
+    ((struct perl_memory_debug_header *)where)->size = size;
+    /* FIXME poison the end if it gets shorter.  */
+#  endif
 #endif
 #ifdef DEBUGGING
     if ((long)size < 0)
@@ -180,6 +188,21 @@ Perl_safesysfree(Malloc_t where)
            /* int *nowhere = NULL; *nowhere = 0; */
             Perl_croak_nocontext("panic: free from wrong pool");
        }
+#  ifdef PERL_POISON
+       {
+           if (((struct perl_memory_debug_header *)where)->in_use
+               == PERL_POISON_FREE) {
+               Perl_croak_nocontext("panic: duplicate free");
+           }
+           if (((struct perl_memory_debug_header *)where)->in_use
+               != PERL_POISON_INUSE) {
+               Perl_croak_nocontext("panic: bad free ");
+           }
+           ((struct perl_memory_debug_header *)where)->in_use
+               = PERL_POISON_FREE;
+       }
+       Poison(where, ((struct perl_memory_debug_header *)where)->size, char);
+#  endif
 #endif
        PerlMem_free(where);
     }
@@ -215,6 +238,10 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size)
        memset((void*)ptr, 0, size);
 #ifdef PERL_TRACK_MEMPOOL
         ((struct perl_memory_debug_header *)ptr)->interpreter = aTHX;
+#  ifdef PERL_POISON
+        ((struct perl_memory_debug_header *)ptr)->size = size;
+        ((struct perl_memory_debug_header *)ptr)->in_use = PERL_POISON_INUSE;
+#  endif
         ptr = (Malloc_t)((char*)ptr+sTHX);
 #endif
        return ptr;