diff options
-rw-r--r-- | av.c | 2 | ||||
-rw-r--r-- | handy.h | 32 | ||||
-rw-r--r-- | perl.h | 7 | ||||
-rw-r--r-- | pod/perldiag.pod | 19 | ||||
-rw-r--r-- | pp.c | 5 |
5 files changed, 65 insertions, 0 deletions
@@ -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; @@ -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 *)) @@ -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 @@ -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; |