From: Ilya Zakharevich Date: Mon, 9 Nov 1998 19:03:25 +0000 (-0500) Subject: Cosmetic malloc patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=741df71a3ace824193f42331175668f1fa76b406;p=p5sagit%2Fp5-mst-13.2.git Cosmetic malloc patch Message-Id: <199811100003.TAA05815@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@2320 --- diff --git a/malloc.c b/malloc.c index 79122fd..2006e3f 100644 --- a/malloc.c +++ b/malloc.c @@ -3,7 +3,8 @@ */ /* - Here are some notes on configuring Perl's malloc. + Here are some notes on configuring Perl's malloc. (For non-perl + usage see below.) There are two macros which serve as bulk disablers of advanced features of this malloc: NO_FANCY_MALLOC, PLAIN_MALLOC (undef by @@ -111,6 +112,43 @@ */ +/* + If used outside of Perl environment, it may be useful to redefine + the following macros (listed below with defaults): + + # Type of address returned by allocation functions + Malloc_t void * + + # Type of size argument for allocation functions + MEM_SIZE unsigned long + + # Maximal value in LONG + LONG_MAX 0x7FFFFFFF + + # Unsigned integer type big enough to keep a pointer + UV unsigned long + + # Type of pointer with 1-byte granularity + caddr_t char * + + # Type returned by free() + Free_t void + + # Fatal error reporting function + croak(format, arg) warn(idem) + exit(1) + + # Error reporting function + warn(format, arg) fprintf(stderr, idem) + + # Locking/unlocking for MT operation + MALLOC_LOCK MUTEX_LOCK(PL_malloc_mutex) + MALLOC_UNLOCK MUTEX_UNLOCK(PL_malloc_mutex) + + # Locking/unlocking mutex for MT operation + MUTEX_LOCK(l) void + MUTEX_UNLOCK(l) void + */ + #ifndef NO_FANCY_MALLOC # ifndef SMALL_BUCKET_VIA_TABLE # define SMALL_BUCKET_VIA_TABLE @@ -167,7 +205,18 @@ * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long. * If PACK_MALLOC is defined, small blocks are 2^n bytes long. * This is designed for use in a program that uses vast quantities of memory, - * but bombs when it runs out. + * but bombs when it runs out. + * + * Modifications Copyright Ilya Zakharevich 1996-98. + * + * Still very quick, but much more thrifty. (Std config is 10% slower + * than it was, and takes 67% of old heap size for typical usage.) + * + * Allocations of small blocks are now table-driven to many different + * buckets. Sizes of really big buckets are increased to accomodata + * common size=power-of-2 blocks. Running-out-of-memory is made into + * an exception. Deeply configurable and thread-safe. + * */ #ifdef PERL_CORE @@ -206,10 +255,10 @@ # define PerlIO_stderr() stderr # endif # ifndef croak /* make depend */ -# define croak(mess, arg) warn((mess), (arg)); exit(1); +# define croak(mess, arg) (warn((mess), (arg)), exit(1)) # endif # ifndef warn -# define warn(mess, arg) fprintf(stderr, (mess), (arg)); +# define warn(mess, arg) fprintf(stderr, (mess), (arg)) # endif # ifdef DEBUG_m # undef DEBUG_m @@ -228,6 +277,14 @@ # define MUTEX_UNLOCK(l) #endif +#ifndef MALLOC_LOCK +# define MALLOC_LOCK MUTEX_LOCK(PL_malloc_mutex) +#endif + +#ifndef MALLOC_UNLOCK +# define MALLOC_UNLOCK MUTEX_UNLOCK(PL_malloc_mutex) +#endif + #ifdef DEBUGGING # undef DEBUG_m # define DEBUG_m(a) if (PL_debug & 128) a @@ -588,7 +645,7 @@ emergency_sbrk(MEM_SIZE size) if (size >= BIG_SIZE) { /* Give the possibility to recover: */ - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; croak("Out of memory during \"large\" request for %i bytes", size); } @@ -635,7 +692,7 @@ emergency_sbrk(MEM_SIZE size) SvCUR(sv) = SvLEN(sv) = 0; } do_croak: - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; croak("Out of memory during request for %i bytes", size); } @@ -706,7 +763,7 @@ malloc(register size_t nbytes) croak("%s", "panic: malloc"); #endif - MUTEX_LOCK(&PL_malloc_mutex); + MALLOC_LOCK; /* * Convert amount of memory requested into * closest block size stored in hash buckets @@ -745,7 +802,7 @@ malloc(register size_t nbytes) if (nextf[bucket] == NULL) morecore(bucket); if ((p = nextf[bucket]) == NULL) { - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; #ifdef PERL_CORE if (!PL_nomemok) { PerlIO_puts(PerlIO_stderr(),"Out of memory!\n"); @@ -795,7 +852,7 @@ malloc(register size_t nbytes) *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC; } #endif - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; return ((Malloc_t)(p + CHUNK_SHIFT)); } @@ -980,7 +1037,7 @@ getpages(int needed, int *nblksp, int bucket) "failed to fix bad sbrk()\n")); #ifdef PACK_MALLOC if (slack) { - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; croak("%s", "panic: Off-page sbrk"); } #endif @@ -1096,7 +1153,7 @@ morecore(register int bucket) if (nextf[bucket]) return; if (bucket == sizeof(MEM_SIZE)*8*BUCKETS_PER_POW2) { - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; croak("%s", "Out of memory during ridiculously large request"); } if (bucket > max_bucket) @@ -1225,7 +1282,7 @@ free(void *mp) #endif return; /* sanity */ } - MUTEX_LOCK(&PL_malloc_mutex); + MALLOC_LOCK; #ifdef RCHECK ASSERT(ovp->ov_rmagic == RMAGIC, "chunk's head overwrite"); if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) { @@ -1248,7 +1305,7 @@ free(void *mp) size = OV_INDEX(ovp); ovp->ov_next = nextf[size]; nextf[size] = ovp; - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; } /* @@ -1286,7 +1343,7 @@ realloc(void *mp, size_t nbytes) if (!cp) return malloc(nbytes); - MUTEX_LOCK(&PL_malloc_mutex); + MALLOC_LOCK; ovp = (union overhead *)((caddr_t)cp - sizeof (union overhead) * CHUNK_SHIFT); bucket = OV_INDEX(ovp); @@ -1384,7 +1441,7 @@ realloc(void *mp, size_t nbytes) } #endif res = cp; - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) realloc %ld bytes inplace\n", (unsigned long)res,(unsigned long)(PL_an++), @@ -1416,7 +1473,7 @@ realloc(void *mp, size_t nbytes) goto hard_way; } else { hard_way: - MUTEX_UNLOCK(&PL_malloc_mutex); + MALLOC_UNLOCK; DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) realloc %ld bytes the hard way\n", (unsigned long)cp,(unsigned long)(PL_an++),