malloc wrappage

Message-Id: <37BF70DE-5C0E-11D8-B5A1-00039362CB92@iki.fi>

plus change croak to Perl_croak_nocontext to make ithread safe
plus make it conditional on PERL_MALLOC_WRAP (default for blead is on)

p4raw-id: //depot/perl@22517

diff --git a/av.c b/av.c
index d37ba01..ac623cc 100644 (file)
--- a/av.c
+++ b/av.c
@@ -114,6 +114,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 #endif 
                newmax = key + AvMAX(av) / 5;
              resize:
+               MEM_WRAP_CHECK_1(newmax+1, SV*, "panic: array extend");
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
                Renew(AvALLOC(av),newmax+1, SV*);
 #else
@@ -148,6 +149,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
            }
            else {
                newmax = key < 3 ? 3 : key;
+               MEM_WRAP_CHECK_1(newmax+1, SV*, "panic: array extend");
                New(2,AvALLOC(av), newmax+1, SV*);
                ary = AvALLOC(av) + 1;
                tmp = newmax;

diff --git a/handy.h b/handy.h
index ad1ebca..bb95814 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -583,6 +583,36 @@ hopefully catches attempts to access uninitialized memory.
 
 #define NEWSV(x,len)   newSV(len)
 
+#ifdef PERL_MALLOC_WRAP
+#define MEM_WRAP_CHECK(n,t) \
+       (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
+#define MEM_WRAP_CHECK_1(n,t,a) \
+       (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
+#define MEM_WRAP_CHECK_2(n,t,a,b) \
+       (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
+
+#define New(x,v,n,t)   (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+#define Newc(x,v,n,t,c)        (v = (MEM_WRAP_CHECK(n,t), (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+#define Newz(x,v,n,t)  (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
+                       memzero((char*)(v), (n)*sizeof(t))
+#define Renew(v,n,t) \
+         (v = (MEM_WRAP_CHECK(n,t), (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
+#define Renewc(v,n,t,c) \
+         (v = (MEM_WRAP_CHECK(n,t), (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
+#define Safefree(d)    safefree((Malloc_t)(d))
+
+#define Move(s,d,n,t)  (MEM_WRAP_CHECK(n,t), (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t)))
+#define Copy(s,d,n,t)  (MEM_WRAP_CHECK(n,t), (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)))
+#define Zero(d,n,t)    (MEM_WRAP_CHECK(n,t), (void)memzero((char*)(d), (n) * sizeof(t)))
+
+#define Poison(d,n,t)  (MEM_WRAP_CHECK(n,t), (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
+
+#else
+
+#define MEM_WRAP_CHECK(n,t) 0
+#define MEM_WRAP_CHECK_1(n,t,a) 0
+#define MEM_WRAP_CHECK_2(n,t,a,b) 0
+
 #define New(x,v,n,t)   (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
 #define Newc(x,v,n,t,c)        (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
 #define Newz(x,v,n,t)  (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \
@@ -599,6 +629,8 @@ hopefully catches attempts to access uninitialized memory.
 
 #define Poison(d,n,t)  (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
 
+#endif
+
 #else /* lint */
 
 #define New(x,v,n,s)   (v = Null(s *))

diff --git a/perl.h b/perl.h
index 1e0ddd1..c57af65 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1767,6 +1767,9 @@ typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
 typedef struct ptr_tbl PTR_TBL_t;
 typedef struct clone_params CLONE_PARAMS;
 
+#ifndef NO_PERL_MALLOC_WRAP
+#define PERL_MALLOC_WRAP       /* We'd like malloc wrap checks.  */
+#endif
 
 #include "handy.h"
 
@@ -3029,6 +3032,10 @@ EXTCONST char PL_no_myglob[]
   INIT("\"my\" variable %s can't be in a package");
 EXTCONST char PL_no_localize_ref[]
   INIT("Can't localize through a reference");
+#ifdef PERL_MALLOC_WRAP
+EXTCONST char PL_memory_wrap[]
+  INIT("panic: memory wrap");
+#endif
 
 EXTCONST char PL_uuemap[65]
   INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 67869a2..e74984c 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2669,6 +2669,11 @@ page.  See L<perlform>.
 
 (P) An internal error.
 
+=item panic: array extend
+
+(P) An attempt was made to extend an array beyond the largest possible
+memory allocation.
+
 =item panic: ck_grep
 
 (P) Failed an internal consistency check trying to compile a grep.
@@ -2745,6 +2750,11 @@ scope.
 (P) The savestack probably got out of sync.  At least, there was an
 invalid enum on the top of it.
 
+=item panic: list extend
+
+(P) An attempt was made to extend a list beyond the largest possible
+memory allocation.
+
 =item panic: magic_killbackrefs
 
 (P) Failed an internal consistency check while trying to reset all weak
@@ -2758,6 +2768,10 @@ references to an object.
 
 (P) The compiler is screwed up with respect to the map() function.
 
+=item panic: memory wrap
+
+(P) Something tried to allocate more memory than possible.
+
 =item panic: null array
 
 (P) One of the internal array routines was passed a null AV pointer.
@@ -2825,6 +2839,11 @@ then discovered it wasn't a subroutine or eval context.
 
 (P) scan_num() got called on something that wasn't a number.
 
+=item panic: string extend
+
+(P) An attempt was made to extend a string beyond the largest possible
+memory allocation.
+
 =item panic: sv_insert
 
 (P) The sv_insert() routine was told to remove more string than there

diff --git a/pp.c b/pp.c
index 18d4eab..8b485fd 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1390,8 +1390,12 @@ PP(pp_repeat)
        dMARK;
        I32 items = SP - MARK;
        I32 max;
+       static const char list_extend[] = "panic: list extend";
 
        max = items * count;
+       MEM_WRAP_CHECK_1(max, SV*, list_extend);
+       if (items > 0 && max > 0 && (max < items || max < count))
+          Perl_croak(aTHX_ list_extend);
        MEXTEND(MARK, max);
        if (count > 1) {
            while (SP > MARK) {
@@ -1444,6 +1448,7 @@ PP(pp_repeat)
            if (count < 1)
                SvCUR_set(TARG, 0);
            else {
+               MEM_WRAP_CHECK_1(count, len, "panic: string extend");
                SvGROW(TARG, (count * len) + 1);
                repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
                SvCUR(TARG) *= count;