From: Ilya Zakharevich Date: Wed, 17 Jun 1998 17:51:54 +0000 (-0400) Subject: Better version of malloc improver X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d720c4410d3a0730e373566db978e2b5789690e0;p=p5sagit%2Fp5-mst-13.2.git Better version of malloc improver Message-Id: <199806172151.RAA28441@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@1167 --- diff --git a/malloc.c b/malloc.c index c87f3cd..2cbdcfd 100644 --- a/malloc.c +++ b/malloc.c @@ -21,8 +21,8 @@ # ifndef TWO_POT_OPTIMIZE # define TWO_POT_OPTIMIZE # endif -# if defined(PERL_CORE) && !defined(EMERGENCY_SBRK) -# define EMERGENCY_SBRK +# if defined(PERL_CORE) && !defined(PERL_EMERGENCY_SBRK) +# define PERL_EMERGENCY_SBRK # endif # if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS) # define DEBUGGING_MSTATS @@ -61,12 +61,46 @@ * but bombs when it runs out. */ -#include "EXTERN.h" -#include "perl.h" - -#ifndef PERL_CORE +#ifdef PERL_CORE +# include "EXTERN.h" +# include "perl.h" +#else +# ifdef PERL_FOR_X2P +# include "../EXTERN.h" +# include "../perl.h" +# else +# include +# include +# include +# define _(arg) arg +# ifndef Malloc_t +# define Malloc_t void * +# endif +# ifndef MEM_SIZE +# define MEM_SIZE unsigned long +# endif +# ifndef LONG_MAX +# define LONG_MAX 0x7FFFFFFF +# endif +# ifndef UV +# define UV unsigned long +# endif +# ifndef caddr_t +# define caddr_t char * +# endif +# ifndef Free_t +# define Free_t void +# endif +# define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +# define PerlEnv_getenv getenv +# define PerlIO_printf fprintf +# define PerlIO_stderr() stderr +# endif # ifndef croak /* make depend */ -# define croak(mess) fprintf(stderr,mess); exit(1); +# define croak(mess, arg) warn((mess), (arg)); exit(1); +# endif +# ifndef warn +# define warn(mess, arg) fprintf(stderr, (mess), (arg)); # endif # ifdef DEBUG_m # undef DEBUG_m @@ -139,7 +173,7 @@ union overhead { }; #ifdef DEBUGGING -static void botch _((char *s)); +static void botch _((char *diag, char *s)); #endif static void morecore _((int bucket)); static int findbucket _((union overhead *freep, int srchlen)); @@ -391,7 +425,7 @@ static char bucket_of[] = #endif #ifndef FIRST_SBRK -# define FIRST_SBRK (32*1024) +# define FIRST_SBRK (48*1024) #endif /* Minimal sbrk in percents of what is already alloced. */ @@ -422,8 +456,8 @@ emergency_sbrk(size) { if (size >= BIG_SIZE) { /* Give the possibility to recover: */ - die("Out of memory during request for %i bytes", size); - /* croak may eat too much memory. */ + MUTEX_UNLOCK(&malloc_mutex); + croak("Out of memory during request for %i bytes", size); } if (!emergency_buffer) { @@ -451,7 +485,8 @@ emergency_sbrk(size) emergency_buffer_size = SvLEN(sv) + M_OVERHEAD; SvPOK_off(sv); SvREADONLY_on(sv); - die("Out of memory!"); /* croak may eat too much memory. */ + MUTEX_UNLOCK(&malloc_mutex); + croak("Out of memory during request for %i bytes", size); } else if (emergency_buffer_size >= size) { emergency_buffer_size -= size; @@ -499,15 +534,15 @@ static u_int start_slack; static u_int goodsbrk; #ifdef DEBUGGING -#define ASSERT(p) if (!(p)) botch(STRINGIFY(p)); else +#define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p)); else static void -botch(char *s) +botch(char *diag, char *s) { - PerlIO_printf(PerlIO_stderr(), "assertion botched: %s\n", s); + PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s); PerlProc_abort(); } #else -#define ASSERT(p) +#define ASSERT(p, diag) #endif Malloc_t @@ -524,7 +559,7 @@ malloc(register size_t nbytes) BARK_64K_LIMIT("Allocation",nbytes,nbytes); #ifdef DEBUGGING if ((long)nbytes < 0) - croak("panic: malloc"); + croak("%s", "panic: malloc"); #endif MUTEX_LOCK(&malloc_mutex); @@ -734,12 +769,12 @@ morecore(register int bucket) if (nextf[bucket]) return; if (bucket == sizeof(MEM_SIZE)*8*BUCKETS_PER_POW2) { - croak("Allocation too large"); + MUTEX_UNLOCK(&malloc_mutex); + croak("%s", "Out of memory during ridiculously large request"); } - - if (bucket > max_bucket) { + if (bucket > max_bucket) max_bucket = bucket; - } + rnu = ( (bucket <= (LOG_OF_MIN_ARENA << BUCKET_POW2_SHIFT)) ? LOG_OF_MIN_ARENA : (bucket >> BUCKET_POW2_SHIFT) ); @@ -762,9 +797,9 @@ morecore(register int bucket) DEBUG_m(PerlIO_printf(Perl_debug_log, "stealing %ld bytes from chain\n", (long) needed)); - } else if (ovp = (union overhead*) - get_from_bigger_buckets((rnu << BUCKET_POW2_SHIFT) + 1, - needed)) { + } else if ( (ovp = (union overhead*) + get_from_bigger_buckets((rnu << BUCKET_POW2_SHIFT) + 1, + needed)) ) { DEBUG_m(PerlIO_printf(Perl_debug_log, "stealing %ld bytes from bigger buckets\n", (long) needed)); @@ -849,8 +884,10 @@ morecore(register int bucket) DEBUG_m(PerlIO_printf(Perl_debug_log, "failed to fix bad sbrk()\n")); #ifdef PACK_MALLOC - if (slack) - croak("panic: Off-page sbrk"); + if (slack) { + MUTEX_UNLOCK(&malloc_mutex); + croak("%s", "panic: Off-page sbrk"); + } #endif if (sbrked_remains) { /* Try again. */ @@ -990,13 +1027,13 @@ free(void *mp) warn("%s free() ignored", ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad"); #else - warn("Bad free() ignored"); + warn("%s", "Bad free() ignored"); #endif return; /* sanity */ } MUTEX_LOCK(&malloc_mutex); #ifdef RCHECK - ASSERT(ovp->ov_rmagic == RMAGIC); + ASSERT(ovp->ov_rmagic == RMAGIC, "chunk's head overwrite"); if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) { int i; MEM_SIZE nbytes = ovp->ov_size + 1; @@ -1005,15 +1042,15 @@ free(void *mp) i = 4 - i; while (i--) { ASSERT(*((char *)((caddr_t)ovp + nbytes - RSLOP + i)) - == RMAGIC_C); + == RMAGIC_C, "chunk's tail overwrite"); } } nbytes = (nbytes + 3) &~ 3; - ASSERT(*(u_int *)((caddr_t)ovp + nbytes - RSLOP) == RMAGIC); + ASSERT(*(u_int *)((caddr_t)ovp + nbytes - RSLOP) == RMAGIC, "chunk's tail overwrite"); } ovp->ov_rmagic = RMAGIC - 1; #endif - ASSERT(OV_INDEX(ovp) < NBUCKETS); + ASSERT(OV_INDEX(ovp) < NBUCKETS, "chunk's head overwrite"); size = OV_INDEX(ovp); ovp->ov_next = nextf[size]; nextf[size] = ovp; @@ -1038,7 +1075,8 @@ realloc(void *mp, size_t nbytes) { register MEM_SIZE onb; union overhead *ovp; - char *res, prev_bucket; + char *res; + int prev_bucket; register int bucket; int was_alloced = 0, incr; char *cp = (char*)mp; @@ -1047,7 +1085,7 @@ realloc(void *mp, size_t nbytes) MEM_SIZE size = nbytes; if ((long)nbytes < 0) - croak("panic: realloc"); + croak("%s", "panic: realloc"); #endif BARK_64K_LIMIT("Reallocation",nbytes,size); @@ -1128,11 +1166,11 @@ realloc(void *mp, size_t nbytes) if ((i = nb & 3)) { i = 4 - i; while (i--) { - ASSERT(*((char *)((caddr_t)ovp + nb - RSLOP + i)) == RMAGIC_C); + ASSERT(*((char *)((caddr_t)ovp + nb - RSLOP + i)) == RMAGIC_C, "chunk's tail overwrite"); } } nb = (nb + 3) &~ 3; - ASSERT(*(u_int *)((caddr_t)ovp + nb - RSLOP) == RMAGIC); + ASSERT(*(u_int *)((caddr_t)ovp + nb - RSLOP) == RMAGIC, "chunk's tail overwrite"); /* * Convert amount of memory requested into * closest block size stored in hash buckets @@ -1303,11 +1341,11 @@ dump_mstats(char *s) } if (s) PerlIO_printf(PerlIO_stderr(), - "Memory allocation statistics %s (buckets %d(%d)..%d(%d)\n", + "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n", s, - BUCKET_SIZE_REAL(MIN_BUCKET), - BUCKET_SIZE(MIN_BUCKET), - BUCKET_SIZE_REAL(topbucket), BUCKET_SIZE(topbucket)); + (long)BUCKET_SIZE_REAL(MIN_BUCKET), + (long)BUCKET_SIZE(MIN_BUCKET), + (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket)); PerlIO_printf(PerlIO_stderr(), "%8d free:", totfree); for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { PerlIO_printf(PerlIO_stderr(),