X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=914436e968bcebada056bd0c774b1f70c65c4e42;hb=cd1a9f552fc30b37bf1b6c770f1367c112fd1b1d;hp=4f0bb4a5c3aa69be4f1d23a1675857e4076b59b0;hpb=9ddc1e7af8675795ad0346c1274fd40d4096c50f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/malloc.c b/malloc.c index 4f0bb4a..914436e 100644 --- a/malloc.c +++ b/malloc.c @@ -379,9 +379,6 @@ # ifndef UVxf # define UVxf "lx" # endif -# ifndef Nullch -# define Nullch NULL -# endif # ifndef MEM_ALIGNBYTES # define MEM_ALIGNBYTES 4 # endif @@ -409,7 +406,7 @@ # define pTHX void # define pTHX_ # ifdef HASATTRIBUTE_UNUSED -# define dTHX PERL_UNUSED_DECL(extern int Perl___notused) +# define dTHX extern int Perl___notused PERL_UNUSED_DECL # else # define dTHX extern int Perl___notused # endif @@ -1291,10 +1288,12 @@ write2(char *mess) #ifdef DEBUGGING #undef ASSERT -#define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p),__FILE__,__LINE__); else +#define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p),__FILE__,__LINE__); + static void botch(char *diag, char *s, char *file, int line) { + dVAR; if (!(PERL_MAYBE_ALIVE && PERL_GET_THX)) goto do_write; else { @@ -1405,22 +1404,12 @@ cmp_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill) # define FILLCHECK_DEADBEEF(s, n) ((void)0) #endif -Malloc_t -Perl_malloc(register size_t nbytes) +int +S_ajust_size_and_find_bucket(size_t *nbytes_p) { - register union overhead *p; - register int bucket; - register MEM_SIZE shiftr; - -#if defined(DEBUGGING) || defined(RCHECK) - MEM_SIZE size = nbytes; -#endif - - BARK_64K_LIMIT("Allocation",nbytes,nbytes); -#ifdef DEBUGGING - if ((long)nbytes < 0) - croak("%s", "panic: malloc"); -#endif + MEM_SIZE shiftr; + int bucket; + size_t nbytes = *nbytes_p; /* * Convert amount of memory requested into @@ -1455,6 +1444,28 @@ Perl_malloc(register size_t nbytes) while (shiftr >>= 1) bucket += BUCKETS_PER_POW2; } + *nbytes_p = nbytes; + return bucket; +} + +Malloc_t +Perl_malloc(size_t nbytes) +{ + dVAR; + register union overhead *p; + register int bucket; + +#if defined(DEBUGGING) || defined(RCHECK) + MEM_SIZE size = nbytes; +#endif + + BARK_64K_LIMIT("Allocation",nbytes,nbytes); +#ifdef DEBUGGING + if ((long)nbytes < 0) + croak("%s", "panic: malloc"); +#endif + + bucket = S_ajust_size_and_find_bucket(&nbytes); MALLOC_LOCK; /* * If nothing in hash bucket right now, @@ -1665,6 +1676,7 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size) static union overhead * getpages(MEM_SIZE needed, int *nblksp, int bucket) { + dVAR; /* Need to do (possibly expensive) system call. Try to optimize it for rare calling. */ MEM_SIZE require = needed - sbrked_remains; @@ -1865,6 +1877,7 @@ getpages_adjacent(MEM_SIZE require) static void morecore(register int bucket) { + dVAR; register union overhead *ovp; register int rnu; /* 2^rnu bytes will be requested */ int nblks; /* become nblks blocks of the desired size */ @@ -1997,11 +2010,12 @@ morecore(register int bucket) } Free_t -Perl_mfree(void *mp) +Perl_mfree(Malloc_t where) { + dVAR; register MEM_SIZE size; register union overhead *ovp; - char *cp = (char*)mp; + char *cp = (char*)where; #ifdef PACK_MALLOC u_char bucket; #endif @@ -2103,6 +2117,7 @@ Perl_mfree(void *mp) Malloc_t Perl_realloc(void *mp, size_t nbytes) { + dVAR; register MEM_SIZE onb; union overhead *ovp; char *res; @@ -2318,7 +2333,7 @@ Perl_strdup(const char *s) MEM_SIZE l = strlen(s); char *s1 = (char *)Perl_malloc(l+1); - return CopyD(s, s1, (MEM_SIZE)(l+1), char); + return (char *)CopyD(s, s1, (MEM_SIZE)(l+1), char); } #ifdef PERL_CORE @@ -2341,7 +2356,7 @@ Perl_putenv(char *a) if (l < sizeof(buf)) var = buf; else - var = Perl_malloc(l + 1); + var = (char *)Perl_malloc(l + 1); Copy(a, var, l, char); var[l + 1] = 0; my_setenv(var, val+1); @@ -2357,6 +2372,9 @@ Perl_malloced_size(void *p) union overhead * const ovp = (union overhead *) ((caddr_t)p - sizeof (union overhead) * CHUNK_SHIFT); const int bucket = OV_INDEX(ovp); + + PERL_ARGS_ASSERT_MALLOCED_SIZE; + #ifdef RCHECK /* The caller wants to have a complete control over the chunk, disable the memory checking inside the chunk. */ @@ -2369,6 +2387,13 @@ Perl_malloced_size(void *p) return BUCKET_SIZE_REAL(bucket); } + +MEM_SIZE +Perl_malloc_good_size(size_t wanted) +{ + return BUCKET_SIZE_REAL(S_ajust_size_and_find_bucket(&wanted)); +} + # ifdef BUCKETS_ROOT2 # define MIN_EVEN_REPORT 6 # else @@ -2383,6 +2408,8 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) register union overhead *p; struct chunk_chain_s* nextchain; + PERL_ARGS_ASSERT_GET_MSTATS; + buf->topbucket = buf->topbucket_ev = buf->topbucket_odd = buf->totfree = buf->total = buf->total_chain = 0; @@ -2423,6 +2450,8 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i); } } +#else /* defined DEBUGGING_MSTATS */ + PerlIO_printf(Perl_error_log, "perl not compiled with DEBUGGING_MSTATS\n"); #endif /* defined DEBUGGING_MSTATS */ return 0; /* XXX unused */ } @@ -2434,7 +2463,7 @@ Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) * frees for each size category. */ void -Perl_dump_mstats(pTHX_ char *s) +Perl_dump_mstats(pTHX_ const char *s) { #ifdef DEBUGGING_MSTATS register int i; @@ -2442,6 +2471,8 @@ Perl_dump_mstats(pTHX_ char *s) UV nf[NBUCKETS]; UV nt[NBUCKETS]; + PERL_ARGS_ASSERT_DUMP_MSTATS; + buffer.nfree = nf; buffer.ntotal = nt; get_mstats(&buffer, NBUCKETS, 0); @@ -2494,6 +2525,8 @@ Perl_dump_mstats(pTHX_ char *s) buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good, buffer.sbrk_slack, buffer.start_slack, buffer.total_chain, buffer.sbrked_remains); +#else /* DEBUGGING_MSTATS */ + PerlIO_printf(Perl_error_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",s); #endif /* DEBUGGING_MSTATS */ }