X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=778f70e7493e540d31a59508f20b3510ad2181f9;hb=249b38c67b3450298e92b9ac6afeebe063da18f8;hp=d543b9b10676e4ee7c2cfe8ab24ba99646d8c3db;hpb=3bdc27670282422f0788ccddd9711ae6cfe9bcd1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/malloc.c b/malloc.c index d543b9b..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 @@ -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 @@ -840,7 +859,7 @@ Perl_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 @@ Perl_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 @@ Perl_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) @@ -1331,7 +1353,7 @@ morecore(register int bucket) Free_t Perl_mfree(void *mp) -{ +{ register MEM_SIZE size; register union overhead *ovp; char *cp = (char*)mp; @@ -1413,7 +1435,7 @@ Perl_mfree(void *mp) Malloc_t Perl_realloc(void *mp, size_t nbytes) -{ +{ register MEM_SIZE onb; union overhead *ovp; char *res; @@ -1426,7 +1448,7 @@ Perl_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); @@ -1613,7 +1635,7 @@ Perl_calloc(register size_t elements, register size_t size) } MEM_SIZE -malloced_size(void *p) +Perl_malloced_size(void *p) { union overhead *ovp = (union overhead *) ((caddr_t)p - sizeof (union overhead) * CHUNK_SHIFT); @@ -1630,8 +1652,6 @@ malloced_size(void *p) return BUCKET_SIZE_REAL(bucket); } -#ifdef DEBUGGING_MSTATS - # ifdef BUCKETS_ROOT2 # define MIN_EVEN_REPORT 6 # else @@ -1645,8 +1665,9 @@ malloced_size(void *p) * frees for each size category. */ void -dump_mstats(char *s) +Perl_dump_mstats(pTHX_ char *s) { +#ifdef DEBUGGING_MSTATS register int i, j; register union overhead *p; int topbucket=0, topbucket_ev=0, topbucket_odd=0, totfree=0, total=0; @@ -1715,16 +1736,10 @@ dump_mstats(char *s) PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n", goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack, start_slack, total_chain, sbrked_remains); +#endif /* DEBUGGING_MSTATS */ } -#else -void -dump_mstats(char *s) -{ -} -#endif #endif /* lint */ - #ifdef USE_PERL_SBRK # if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__)