summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--av.c2
-rw-r--r--handy.h32
-rw-r--r--perl.h7
-rw-r--r--pod/perldiag.pod19
-rw-r--r--pp.c5
5 files changed, 65 insertions, 0 deletions
diff --git a/av.c b/av.c
index d37ba01c01..ac623cc2de 100644
--- 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 ad1ebcacd5..bb95814075 100644
--- 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 1e0ddd19d3..c57af65196 100644
--- 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 67869a297d..e74984c4eb 100644
--- 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 18d4eab2d3..8b485fda1f 100644
--- 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;