X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=2db2a6a6bcd1cc41e97ed2ecb9e835542c4f43e8;hb=154d43cbcf57271c884e15f24587b4e8d54edbdb;hp=0dc732cc7d3e2e7fe30f69d215c180d33d8e248d;hpb=76cfd9aab7f7c0e39ea86aa1b2b9572c573b7b6f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/malloc.c b/malloc.c index 0dc732c..2db2a6a 100644 --- a/malloc.c +++ b/malloc.c @@ -125,6 +125,9 @@ # Type of size argument for allocation functions MEM_SIZE unsigned long + # size of void* + PTRSIZE 4 + # Maximal value in LONG LONG_MAX 0x7FFFFFFF @@ -147,8 +150,8 @@ warn(format, arg) fprintf(stderr, idem) # Locking/unlocking for MT operation - MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex) - MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex) + MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex) + MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex) # Locking/unlocking mutex for MT operation MUTEX_LOCK(l) void @@ -245,6 +248,9 @@ # ifndef Malloc_t # define Malloc_t void * # endif +# ifndef PTRSIZE +# define PTRSIZE 4 +# endif # ifndef MEM_SIZE # define MEM_SIZE unsigned long # endif @@ -313,11 +319,11 @@ #endif #ifndef MALLOC_LOCK -# define MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex) +# define MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex) #endif #ifndef MALLOC_UNLOCK -# define MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex) +# define MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex) #endif # ifndef fatalcroak /* make depend */ @@ -435,8 +441,8 @@ union overhead { double strut; /* alignment problems */ #endif struct { - u_char ovu_magic; /* magic number */ u_char ovu_index; /* bucket # */ + u_char ovu_magic; /* magic number */ #ifdef RCHECK u_short ovu_size; /* actual block size */ u_int ovu_rmagic; /* range magic number */ @@ -822,6 +828,16 @@ static char bucket_of[] = # define SBRK_FAILURE_PRICE 50 #endif +static void morecore (register int bucket); +# if defined(DEBUGGING) +static void botch (char *diag, char *s); +# endif +static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip); +static void* get_from_chain (MEM_SIZE size); +static void* get_from_bigger_buckets(int bucket, MEM_SIZE size); +static union overhead *getpages (MEM_SIZE needed, int *nblksp, int bucket); +static int getpages_adjacent(MEM_SIZE require); + #if defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE) # ifndef BIG_SIZE @@ -838,18 +854,6 @@ static char bucket_of[] = static char *emergency_buffer; static MEM_SIZE emergency_buffer_size; -static int findbucket (union overhead *freep, int srchlen); -static void morecore (register int bucket); -# if defined(DEBUGGING) -static void botch (char *diag, char *s); -# endif -static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip); -static Malloc_t emergency_sbrk (MEM_SIZE size); -static void* get_from_chain (MEM_SIZE size); -static void* get_from_bigger_buckets(int bucket, MEM_SIZE size); -static union overhead *getpages (int needed, int *nblksp, int bucket); -static int getpages_adjacent(int require); - static Malloc_t emergency_sbrk(MEM_SIZE size) { @@ -915,12 +919,16 @@ emergency_sbrk(MEM_SIZE size) # define emergency_sbrk(size) -1 #endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */ +#ifndef BITS_IN_PTR +# define BITS_IN_PTR (8*PTRSIZE) +#endif + /* * nextf[i] is the pointer to the next free block of size 2^i. The * smallest allocatable block is 8 bytes. The overhead information * precedes the data area returned to the user. */ -#define NBUCKETS (32*BUCKETS_PER_POW2 + 1) +#define NBUCKETS (BITS_IN_PTR*BUCKETS_PER_POW2 + 1) static union overhead *nextf[NBUCKETS]; #if defined(PURIFY) && !defined(USE_PERL_SBRK) @@ -1052,7 +1060,7 @@ Perl_malloc(register size_t nbytes) dTHX; PerlIO_printf(PerlIO_stderr(), "Unaligned `next' pointer in the free " - "chain 0x"UVxf" at 0x%"UVxf"\n", + "chain 0x%"UVxf" at 0x%"UVxf"\n", PTR2UV(p->ov_next), PTR2UV(p)); } #endif @@ -1190,14 +1198,14 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size) } static union overhead * -getpages(int needed, int *nblksp, int bucket) +getpages(MEM_SIZE needed, int *nblksp, int bucket) { /* Need to do (possibly expensive) system call. Try to optimize it for rare calling. */ MEM_SIZE require = needed - sbrked_remains; char *cp; union overhead *ovp; - int slack = 0; + MEM_SIZE slack = 0; if (sbrk_good > 0) { if (!last_sbrk_top && require < FIRST_SBRK) @@ -1343,7 +1351,7 @@ getpages(int needed, int *nblksp, int bucket) } static int -getpages_adjacent(int require) +getpages_adjacent(MEM_SIZE require) { if (require <= sbrked_remains) { sbrked_remains -= require; @@ -1766,28 +1774,6 @@ Perl_realloc(void *mp, size_t nbytes) return ((Malloc_t)res); } -/* - * Search ``srchlen'' elements of each free list for a block whose - * header starts at ``freep''. If srchlen is -1 search the whole list. - * Return bucket number, or -1 if not found. - */ -static int -findbucket(union overhead *freep, int srchlen) -{ - register union overhead *p; - register int i, j; - - for (i = 0; i < NBUCKETS; i++) { - j = 0; - for (p = nextf[i]; p && j != srchlen; p = p->ov_next) { - if (p == freep) - return (i); - j++; - } - } - return (-1); -} - Malloc_t Perl_calloc(register size_t elements, register size_t size) { @@ -1992,17 +1978,6 @@ Perl_dump_mstats(pTHX_ char *s) # if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__) || defined(PURIFY) # define PERL_SBRK_VIA_MALLOC -/* - * MachTen's malloc() returns a buffer aligned on a two-byte boundary. - * While this is adequate, it may slow down access to longer data - * types by forcing multiple memory accesses. It also causes - * complaints when RCHECK is in force. So we allocate six bytes - * more than we need to, and return an address rounded up to an - * eight-byte boundary. - * - * 980701 Dominic Dunlop - */ -# define SYSTEM_ALLOC_ALIGNMENT 2 # endif # ifdef PERL_SBRK_VIA_MALLOC