re-[PATCH] Re: [PATCH] Poison now in two different flavours!

Message-ID: <442680D4.3000809@gmail.com>

p4raw-id: //depot/perl@27626

8 files changed, 60 insertions, 21 deletions

diff --git a/handy.h b/handy.h
index 66ce4d125c..010cd9a622 100644
--- a/handy.h
+++ b/handy.h
@@ -617,10 +617,22 @@ optimise.
 =for apidoc Am|void|StructCopy|type src|type dest|type
 This is an architecture-independent macro to copy one structure to another.
 
+=for apidoc Am|void|PoisonWith|void* dest|int nitems|type|U8 byte
+
+Fill up memory with a byte pattern (a byte repeated over and over
+again) that hopefully catches attempts to access uninitialized memory.
+
+=for apidoc Am|void|PoisonNew|void* dest|int nitems|type
+
+PoisonWith(0xAB) for catching access to allocated but uninitialized memory.
+
+=for apidoc Am|void|Poison|void* dest|int nitems|type
+
+PoisonWith(0xEF) for catching access to freed memory.
+
 =for apidoc Am|void|Poison|void* dest|int nitems|type
 
-Fill up memory with a pattern (byte 0xAB over and over again) that
-hopefully catches attempts to access uninitialized memory.
+PoisonWith(0xEF) for catching access to freed memory.
 
 =cut */
 
@@ -740,7 +752,10 @@ Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int li
 #define ZeroD(d,n,t)	(MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)),d)
 #endif
 
-#define Poison(d,n,t)	(MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
+#define PoisonWith(d,n,t,b)	(MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)))
+#define PoisonNew(d,n,t)	PoisonWith(d,n,t,0xAB)
+#define PoisonFree(d,n,t)	PoisonWith(d,n,t,0xEF)
+#define Poison(d,n,t)		PoisonFree(d,n,t)
 
 #ifdef USE_STRUCT_COPY
 #define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s)))
diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 7b8a77c6e6..6af8b05cfd 100644
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -2022,14 +2022,34 @@ Found in file handy.h
 =item Poison
 X<Poison>
 
-Fill up memory with a pattern (byte 0xAB over and over again) that
-hopefully catches attempts to access uninitialized memory.
+PoisonWith(0xEF) for catching access to freed memory.
 
 	void	Poison(void* dest, int nitems, type)
 
 =for hackers
 Found in file handy.h
 
+=item PoisonNew
+X<PoisonNew>
+
+PoisonWith(0xAB) for catching access to allocated but uninitialized memory.
+
+	void	PoisonNew(void* dest, int nitems, type)
+
+=for hackers
+Found in file handy.h
+
+=item PoisonWith
+X<PoisonWith>
+
+Fill up memory with a byte pattern (a byte repeated over and over
+again) that hopefully catches attempts to access uninitialized memory.
+
+	void	PoisonWith(void* dest, int nitems, type, U8 byte)
+
+=for hackers
+Found in file handy.h
+
 =item Renew
 X<Renew>
 
diff --git a/pod/perlclib.pod b/pod/perlclib.pod
index 837a36da67..f676842f60 100644
--- a/pod/perlclib.pod
+++ b/pod/perlclib.pod
@@ -138,9 +138,12 @@ pattern into it that should be illegal as pointers (and floating point
 numbers), and also hopefully surprising enough as integers, so that
 any code attempting to use the data without forethought will break
 sooner rather than later.  Poisoning can be done using the Poison()
-macro, which has similar arguments as Zero():
+macros, which have similar arguments as Zero():
 
-    Poison(dst, n, t)
+    PoisonWith(dst, n, t, b)    scribble memory with byte b
+    PoisonNew(dst, n, t)        equal to PoisonWith(dst, n, t, 0xAB)
+    PoisonFree(dst, n, t)       equal to PoisonWith(dst, n, t, 0xEF)
+    Poison(dst, n, t)           equal to PoisonFree(dst, n, t)
 
 =head2 Character Class Tests
 
diff --git a/pod/perlhack.pod b/pod/perlhack.pod
index f4bbb695ed..a976c77c84 100644
--- a/pod/perlhack.pod
+++ b/pod/perlhack.pod
@@ -2712,8 +2712,9 @@ section.
 
 =item *
 
-If you see in a debugger a memory area mysteriously full of 0xabababab,
-you may be seeing the effect of the Poison() macro, see L<perlclib>.
+If you see in a debugger a memory area mysteriously full of 0xABABABAB
+or 0xEFEFEFEF, you may be seeing the effect of the Poison() macros,
+see L<perlclib>.
 
 =back
 
diff --git a/pp_ctl.c b/pp_ctl.c
index c0e3a0965d..5621db6180 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -380,7 +380,7 @@ Perl_rxres_free(pTHX_ void **rsp)
 	void *tmp = INT2PTR(char*,*p);
 	Safefree(tmp);
 	if (*p)
-	    Poison(*p, 1, sizeof(*p));
+	    PoisonFree(*p, 1, sizeof(*p));
 #else
 	Safefree(INT2PTR(char*,*p));
 #endif
diff --git a/scope.c b/scope.c
index ff063d22a0..a49a82a023 100644
--- a/scope.c
+++ b/scope.c
@@ -62,7 +62,7 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
     Newx(si->si_cxstack, cxitems, PERL_CONTEXT);
     /* Without any kind of initialising PUSHSUBST()
      * in pp_subst() will read uninitialised heap. */
-    Poison(si->si_cxstack, cxitems, PERL_CONTEXT);
+    PoisonNew(si->si_cxstack, cxitems, PERL_CONTEXT);
     return si;
 }
 
@@ -75,7 +75,7 @@ Perl_cxinc(pTHX)
     Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);	/* XXX should fix CXINC macro */
     /* Without any kind of initialising deep enough recursion
      * will end up reading uninitialised PERL_CONTEXTs. */
-    Poison(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
+    PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
     return cxstack_ix + 1;
 }
 
diff --git a/sv.c b/sv.c
index 1388b468a4..fa670b1461 100644
--- a/sv.c
+++ b/sv.c
@@ -190,10 +190,10 @@ Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size)
 #  define SvARENA_CHAIN(sv)	((sv)->sv_u.svu_rv)
 /* Whilst I'd love to do this, it seems that things like to check on
    unreferenced scalars
-#  define POSION_SV_HEAD(sv)	Poison(sv, 1, struct STRUCT_SV)
+#  define POSION_SV_HEAD(sv)	PoisonNew(sv, 1, struct STRUCT_SV)
 */
-#  define POSION_SV_HEAD(sv)	Poison(&SvANY(sv), 1, void *), \
-				Poison(&SvREFCNT(sv), 1, U32)
+#  define POSION_SV_HEAD(sv)	PoisonNew(&SvANY(sv), 1, void *), \
+				PoisonNew(&SvREFCNT(sv), 1, U32)
 #else
 #  define SvARENA_CHAIN(sv)	SvANY(sv)
 #  define POSION_SV_HEAD(sv)
@@ -10727,7 +10727,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PERL_SET_THX(my_perl);
 
 #  ifdef DEBUGGING
-    Poison(my_perl, 1, PerlInterpreter);
+    PoisonNew(my_perl, 1, PerlInterpreter);
     PL_op = NULL;
     PL_curcop = NULL;
     PL_markstack = 0;
@@ -10761,7 +10761,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PERL_SET_THX(my_perl);
 
 #    ifdef DEBUGGING
-    Poison(my_perl, 1, PerlInterpreter);
+    PoisonNew(my_perl, 1, PerlInterpreter);
     PL_op = NULL;
     PL_curcop = NULL;
     PL_markstack = 0;
diff --git a/util.c b/util.c
index 4022bb0830..9239070870 100644
--- a/util.c
+++ b/util.c
@@ -99,7 +99,7 @@ Perl_safesysmalloc(MEM_SIZE size)
 #endif
 
 #ifdef PERL_POISON
-	Poison(((char *)ptr), size, char);
+	PoisonNew(((char *)ptr), size, char);
 #endif
 
 #ifdef PERL_TRACK_MEMPOOL
@@ -165,7 +165,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 	if (header->size > size) {
 	    const MEM_SIZE freed_up = header->size - size;
 	    char *start_of_freed = ((char *)where) + size;
-	    Poison(start_of_freed, freed_up, char);
+	    PoisonFree(start_of_freed, freed_up, char);
 	}
 	header->size = size;
 #  endif
@@ -190,7 +190,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 	if (header->size < size) {
 	    const MEM_SIZE fresh = size - header->size;
 	    char *start_of_fresh = ((char *)ptr) + size;
-	    Poison(start_of_fresh, fresh, char);
+	    PoisonNew(start_of_fresh, fresh, char);
 	}
 #  endif
 
@@ -241,7 +241,7 @@ Perl_safesysfree(Malloc_t where)
 	    header->next->prev = header->prev;
 	    header->prev->next = header->next;
 #  ifdef PERL_POISON
-	    Poison(where, header->size, char);
+	    PoisonNew(where, header->size, char);
 #  endif
 	    /* Trigger the duplicate free warning.  */
 	    header->next = NULL;