X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=778f70e7493e540d31a59508f20b3510ad2181f9;hb=249b38c67b3450298e92b9ac6afeebe063da18f8;hp=e8fe41eafcdd342534365c12149fdbb5353d114d;hpb=61ae2fbf8676dafa05a9a9a710fde421f30a2071;p=p5sagit%2Fp5-mst-13.2.git diff --git a/malloc.c b/malloc.c index e8fe41e..778f70e 100644 --- a/malloc.c +++ b/malloc.c @@ -147,8 +147,8 @@ 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) + MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex) + MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex) # Locking/unlocking mutex for MT operation MUTEX_LOCK(l) void @@ -213,7 +213,7 @@ * This is designed for use in a program that uses vast quantities of memory, * but bombs when it runs out. * - * Modifications Copyright Ilya Zakharevich 1996-98. + * Modifications Copyright Ilya Zakharevich 1996-99. * * 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.) @@ -227,7 +227,12 @@ #ifdef PERL_CORE # include "EXTERN.h" +#define PERL_IN_MALLOC_C # include "perl.h" +# if defined(PERL_IMPLICIT_CONTEXT) +# define croak Perl_croak_nocontext +# define warn Perl_warn_nocontext +# endif #else # ifdef PERL_FOR_X2P # include "../EXTERN.h" @@ -273,6 +278,15 @@ # ifdef DEBUGGING # undef DEBUGGING # endif +# ifndef pTHX +# define pTHX void +# define pTHX_ +# define dTHX extern int Perl___notused +# define WITH_THX(s) s +# endif +# ifndef PERL_GET_INTERP +# define PERL_GET_INTERP PL_curinterp +# endif #endif #ifndef MUTEX_LOCK @@ -284,11 +298,11 @@ #endif #ifndef MALLOC_LOCK -# define MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex) +# define MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex) #endif #ifndef MALLOC_UNLOCK -# define MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex) +# define MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex) #endif # ifndef fatalcroak /* make depend */ @@ -297,7 +311,10 @@ #ifdef DEBUGGING # undef DEBUG_m -# define DEBUG_m(a) if (PL_debug & 128) a +# define DEBUG_m(a) \ + STMT_START { \ + if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } } \ + } STMT_END #endif /* @@ -367,13 +384,11 @@ #define u_char unsigned char #define u_int unsigned int - -#ifdef HAS_QUAD -# define u_bigint UV /* Needs to eat *void. */ -#else /* needed? */ -# define u_bigint unsigned long /* Needs to eat *void. */ -#endif - +/* + * I removed the definition of u_bigint which appeared to be u_bigint = UV + * u_bigint was only used in TWOK_MASKED and TWOK_SHIFT + * where I have used PTR2UV. RMB + */ #define u_short unsigned short /* 286 and atarist like big chunks, which gives too much overhead. */ @@ -411,13 +426,6 @@ union overhead { #define ov_rmagic ovu.ovu_rmagic }; -#ifdef DEBUGGING -static void botch _((char *diag, char *s)); -#endif -static void morecore _((int bucket)); -static int findbucket _((union overhead *freep, int srchlen)); -static void add_to_chain(void *p, MEM_SIZE size, MEM_SIZE chip); - #define MAGIC 0xff /* magic # on accounting info */ #define RMAGIC 0x55555555 /* magic # on range info */ #define RMAGIC_C 0x55 /* magic # on range info */ @@ -506,9 +514,9 @@ static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = # define MAX_PACKED (MAX_PACKED_POW2 * BUCKETS_PER_POW2 + BUCKET_POW2_SHIFT) # define MAX_POW2_ALGO ((1<<(MAX_PACKED_POW2 + 1)) - M_OVERHEAD) # define TWOK_MASK ((1<> \ @@ -715,7 +723,18 @@ static char bucket_of[] = static char *emergency_buffer; static MEM_SIZE emergency_buffer_size; -static Malloc_t emergency_sbrk(MEM_SIZE 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) @@ -735,7 +754,7 @@ emergency_sbrk(MEM_SIZE size) emergency_buffer += rsize; return old; } else { - dTHR; + dTHX; /* First offense, give a possibility to recover by dieing. */ /* No malloc involved here: */ GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0); @@ -760,7 +779,7 @@ emergency_sbrk(MEM_SIZE size) /* Got it, now detach SvPV: */ pv = SvPV(sv, n_a); /* Check alignment: */ - if (((UV)(pv - sizeof(union overhead))) & (NEEDED_ALIGNMENT - 1)) { + if ((PTR2UV(pv) - sizeof(union overhead)) & (NEEDED_ALIGNMENT - 1)) { PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n"); return (char *)-1; /* die die die */ } @@ -790,7 +809,7 @@ static union overhead *nextf[NBUCKETS]; #ifdef USE_PERL_SBRK #define sbrk(a) Perl_sbrk(a) -Malloc_t Perl_sbrk _((int size)); +Malloc_t Perl_sbrk (int size); #else #ifdef DONT_DECLARE_STD #ifdef I_UNISTD @@ -827,7 +846,7 @@ botch(char *diag, char *s) #endif Malloc_t -malloc(register size_t nbytes) +Perl_malloc(register size_t nbytes) { register union overhead *p; register int bucket; @@ -840,7 +859,7 @@ malloc(register size_t nbytes) BARK_64K_LIMIT("Allocation",nbytes,nbytes); #ifdef DEBUGGING if ((long)nbytes < 0) - croak("%s", "panic: malloc"); + croak("%s", "panic: malloc"); #endif MALLOC_LOCK; @@ -884,9 +903,12 @@ malloc(register size_t nbytes) if ((p = nextf[bucket]) == NULL) { MALLOC_UNLOCK; #ifdef PERL_CORE - if (!PL_nomemok) { - PerlIO_puts(PerlIO_stderr(),"Out of memory!\n"); - my_exit(1); + { + dTHX; + if (!PL_nomemok) { + PerlIO_puts(PerlIO_stderr(),"Out of memory!\n"); + my_exit(1); + } } #else return (NULL); @@ -900,7 +922,7 @@ malloc(register size_t nbytes) /* remove from linked list */ #if defined(RCHECK) - if (((UV)p) & (MEM_ALIGNBYTES - 1)) + if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n", (unsigned long)*((int*)p),(unsigned long)p); #endif @@ -1097,8 +1119,8 @@ getpages(int needed, int *nblksp, int bucket) # ifndef I286 /* The sbrk(0) call on the I286 always returns the next segment */ /* WANTED_ALIGNMENT may be more than NEEDED_ALIGNMENT, but this may improve performance of memory access. */ - if ((UV)cp & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */ - slack = WANTED_ALIGNMENT - ((UV)cp & (WANTED_ALIGNMENT - 1)); + if (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */ + slack = WANTED_ALIGNMENT - (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)); add += slack; } # endif @@ -1159,16 +1181,16 @@ getpages(int needed, int *nblksp, int bucket) */ # if NEEDED_ALIGNMENT > MEM_ALIGNBYTES - if ((UV)ovp & (NEEDED_ALIGNMENT - 1)) + if (PTR2UV(ovp) & (NEEDED_ALIGNMENT - 1)) fatalcroak("Misalignment of sbrk()\n"); else # endif #ifndef I286 /* Again, this should always be ok on an 80286 */ - if ((UV)ovp & (MEM_ALIGNBYTES - 1)) { + if (PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)) { DEBUG_m(PerlIO_printf(Perl_debug_log, "fixing sbrk(): %d bytes off machine alignement\n", - (int)((UV)ovp & (MEM_ALIGNBYTES - 1)))); - ovp = (union overhead *)(((UV)ovp + MEM_ALIGNBYTES) & + (int)(PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)))); + ovp = INT2PTR(union overhead *,(PTR2UV(ovp) + MEM_ALIGNBYTES) & (MEM_ALIGNBYTES - 1)); (*nblksp)--; # if defined(DEBUGGING_MSTATS) @@ -1330,8 +1352,8 @@ morecore(register int bucket) } Free_t -free(void *mp) -{ +Perl_mfree(void *mp) +{ register MEM_SIZE size; register union overhead *ovp; char *cp = (char*)mp; @@ -1412,8 +1434,8 @@ free(void *mp) #define reall_srchlen 4 /* 4 should be plenty, -1 =>'s whole list */ Malloc_t -realloc(void *mp, size_t nbytes) -{ +Perl_realloc(void *mp, size_t nbytes) +{ register MEM_SIZE onb; union overhead *ovp; char *res; @@ -1426,12 +1448,12 @@ realloc(void *mp, size_t nbytes) MEM_SIZE size = nbytes; if ((long)nbytes < 0) - croak("%s", "panic: realloc"); + croak("%s", "panic: realloc"); #endif BARK_64K_LIMIT("Reallocation",nbytes,size); if (!cp) - return malloc(nbytes); + return Perl_malloc(nbytes); MALLOC_LOCK; ovp = (union overhead *)((caddr_t)cp @@ -1568,12 +1590,12 @@ realloc(void *mp, size_t nbytes) "0x%lx: (%05lu) realloc %ld bytes the hard way\n", (unsigned long)cp,(unsigned long)(PL_an++), (long)size)); - if ((res = (char*)malloc(nbytes)) == NULL) + if ((res = (char*)Perl_malloc(nbytes)) == NULL) return (NULL); if (cp != res) /* common optimization */ Copy(cp, res, (MEM_SIZE)(nbytes SYSTEM_ALLOC_ALIGNMENT - got = (got + NEEDED_ALIGNMENT - 1) & (NEEDED_ALIGNMENT - 1); + got = (got + NEEDED_ALIGNMENT - 1) & ~(NEEDED_ALIGNMENT - 1); # endif if (small) { /* Chunk is small, register the rest for future allocs. */