X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=4ec2174343a0adf3e4324b271c5850ec3281307b;hb=4b711db359c9778a062571f88eafc4dab0b9c81d;hp=0656064177185581f957508c9311f91f8195d6e1;hpb=2b1d54e56963cfc0f0bdfe890c87eeb20bb70fc1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/malloc.c b/malloc.c index 0656064..4ec2174 100644 --- a/malloc.c +++ b/malloc.c @@ -6,6 +6,12 @@ * "'The Chamber of Records,' said Gimli. 'I guess that is where we now stand.'" */ +/* This file contains Perl's own implementation of the malloc library. + * It is used if Configure decides that, on your platform, Perl's + * version is better than the OS's, or if you give Configure the + * -Dusemymalloc command-line option. + */ + /* Here are some notes on configuring Perl's malloc. (For non-perl usage see below.) @@ -265,19 +271,18 @@ # define LOG_OF_MIN_ARENA 14 #endif -#ifndef lint -# if defined(DEBUGGING) && !defined(NO_RCHECK) -# define RCHECK -# endif -# if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_MFILL) && !defined(MALLOC_FILL) -# define MALLOC_FILL -# endif -# if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_FILL_CHECK) && !defined(MALLOC_FILL_CHECK) -# define MALLOC_FILL_CHECK -# endif -# if defined(RCHECK) && defined(IGNORE_SMALL_BAD_FREE) -# undef IGNORE_SMALL_BAD_FREE -# endif +#if defined(DEBUGGING) && !defined(NO_RCHECK) +# define RCHECK +#endif +#if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_MFILL) && !defined(MALLOC_FILL) +# define MALLOC_FILL +#endif +#if defined(DEBUGGING) && !defined(NO_RCHECK) && !defined(NO_FILL_CHECK) && !defined(MALLOC_FILL_CHECK) +# define MALLOC_FILL_CHECK +#endif +#if defined(RCHECK) && defined(IGNORE_SMALL_BAD_FREE) +# undef IGNORE_SMALL_BAD_FREE +#endif /* * malloc.c (Caltech) 2/21/82 * Chris Kingsley, kingsley@cit-20. @@ -357,6 +362,7 @@ # define Free_t void # endif # define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) # define PerlEnv_getenv getenv # define PerlIO_printf fprintf # define PerlIO_stderr() stderr @@ -402,7 +408,7 @@ # ifndef pTHX # define pTHX void # define pTHX_ -# ifdef HASATTRIBUTE +# ifdef HASATTRIBUTE_UNUSED # define dTHX extern int Perl___notused PERL_UNUSED_DECL # else # define dTHX extern int Perl___notused @@ -634,7 +640,7 @@ struct aligner { #ifdef BUCKETS_ROOT2 # define MAX_BUCKET_BY_TABLE 13 -static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = +static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = { 0, 0, 0, 0, 4, 4, 8, 12, 16, 24, 32, 48, 64, 80, }; @@ -798,7 +804,7 @@ static u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = # define N_BLKS(bucket) n_blks[bucket] #endif -static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = +static const u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = { # if BUCKETS_PER_POW2==1 0, 0, @@ -821,7 +827,7 @@ static u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = # define BLK_SHIFT(bucket) blk_shift[bucket] #endif -static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = +static const u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = { # if BUCKETS_PER_POW2==1 0, 0, @@ -869,7 +875,7 @@ static u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = # else # define SIZE_TABLE_MAX 64 # endif -static char bucket_of[] = +static const char bucket_of[] = { # ifdef BUCKETS_ROOT2 /* Chunks of size 3*2^n. */ /* 0 to 15 in 4-byte increments. */ @@ -1068,6 +1074,12 @@ static IV MallocCfg[MallocCfg_last] = { }; IV *MallocCfg_ptr = MallocCfg; +static char* MallocCfgP[MallocCfg_last] = { + 0, /* MallocCfgP_emergency_buffer */ + 0, /* MallocCfgP_emergency_buffer_prepared */ +}; +char **MallocCfgP_ptr = MallocCfgP; + # undef MIN_SBRK # undef FIRST_SBRK # undef MIN_SBRK_FRAC1000 @@ -1090,6 +1102,9 @@ IV *MallocCfg_ptr = MallocCfg; # define FILL_CHECK_CFG MallocCfg[MallocCfg_fillcheck] # define FILL_CHECK (FILL_DEAD && FILL_CHECK_CFG) +# define emergency_buffer MallocCfgP[MallocCfgP_emergency_buffer] +# define emergency_buffer_prepared MallocCfgP[MallocCfgP_emergency_buffer_prepared] + #else /* defined(NO_MALLOC_DYNAMIC_CFG) */ # define FILL_DEAD 1 @@ -1121,14 +1136,13 @@ static u_int goodsbrk; # define BIG_SIZE (1<<16) /* 64K */ # endif -static char *emergency_buffer; -static char *emergency_buffer_prepared; - # ifdef NO_MALLOC_DYNAMIC_CFG static MEM_SIZE emergency_buffer_size; /* 0 if the last request for more memory succeeded. Otherwise the size of the failing request. */ static MEM_SIZE emergency_buffer_last_req; +static char *emergency_buffer; +static char *emergency_buffer_prepared; # endif # ifndef emergency_sbrk_croak @@ -1145,14 +1159,13 @@ perl_get_emergency_buffer(IV *size) GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0); SV *sv; char *pv; - STRLEN n_a; if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0); if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) || (SvLEN(sv) < (1<>LOG_OF_MIN_ARENA) + 1)<= BIG_SIZE - && (!emergency_buffer_last_req || (size < emergency_buffer_last_req))) { + && (!emergency_buffer_last_req || + (size < (MEM_SIZE)emergency_buffer_last_req))) { /* Give the possibility to recover, but avoid an infinite cycle. */ MALLOC_UNLOCK; emergency_buffer_last_req = size; emergency_sbrk_croak("Out of memory during \"large\" request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack)); } - if (emergency_buffer_size >= rsize) { + if ((MEM_SIZE)emergency_buffer_size >= rsize) { char *old = emergency_buffer; emergency_buffer_size -= rsize; @@ -1321,7 +1336,7 @@ fill_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill) { unsigned char *e = s + nbytes; long *lp; - long lfill = *(long*)fill; + const long lfill = *(long*)fill; if (PTR2UV(s) & (sizeof(long)-1)) { /* Align the pattern */ int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1)); @@ -1362,7 +1377,7 @@ cmp_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill) { unsigned char *e = s + nbytes; long *lp; - long lfill = *(long*)fill; + const long lfill = *(long*)fill; if (PTR2UV(s) & (sizeof(long)-1)) { /* Align the pattern */ int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1)); @@ -1500,7 +1515,7 @@ Perl_malloc(register size_t nbytes) || (p->ov_next && PTR2UV(p->ov_next) < (1<ov_next), PTR2UV(p)); } @@ -1658,9 +1673,9 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) MEM_SIZE slack = 0; if (sbrk_goodness > 0) { - if (!last_sbrk_top && require < FIRST_SBRK) + if (!last_sbrk_top && require < (MEM_SIZE)FIRST_SBRK) require = FIRST_SBRK; - else if (require < MIN_SBRK) require = MIN_SBRK; + else if (require < (MEM_SIZE)MIN_SBRK) require = MIN_SBRK; if (require < goodsbrk * MIN_SBRK_FRAC1000 / 1000) require = goodsbrk * MIN_SBRK_FRAC1000 / 1000; @@ -1789,7 +1804,7 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) # endif } #endif - ; /* Finish `else' */ + ; /* Finish "else" */ sbrked_remains = require - needed; last_op = cp; } @@ -1883,9 +1898,9 @@ morecore(register int bucket) } } if (t && *t) { - write2("Unrecognized part of PERL_MALLOC_OPT: `"); + write2("Unrecognized part of PERL_MALLOC_OPT: \""); write2(t); - write2("'\n"); + write2("\"\n"); } if (changed) MallocCfg[MallocCfg_cfg_env_read] = 1; @@ -2303,8 +2318,7 @@ Perl_strdup(const char *s) MEM_SIZE l = strlen(s); char *s1 = (char *)Perl_malloc(l+1); - Copy(s, s1, (MEM_SIZE)(l+1), char); - return s1; + return CopyD(s, s1, (MEM_SIZE)(l+1), char); } #ifdef PERL_CORE @@ -2342,12 +2356,12 @@ Perl_malloced_size(void *p) { union overhead *ovp = (union overhead *) ((caddr_t)p - sizeof (union overhead) * CHUNK_SHIFT); - int bucket = OV_INDEX(ovp); + const int bucket = OV_INDEX(ovp); #ifdef RCHECK /* The caller wants to have a complete control over the chunk, disable the memory checking inside the chunk. */ if (bucket <= MAX_SHORT_BUCKET) { - MEM_SIZE size = BUCKET_SIZE_REAL(bucket); + const MEM_SIZE size = BUCKET_SIZE_REAL(bucket); ovp->ov_size = size + M_OVERHEAD - 1; *((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RMAGIC_SZ)) = RMAGIC; } @@ -2482,7 +2496,6 @@ Perl_dump_mstats(pTHX_ char *s) buffer.total_chain, buffer.sbrked_remains); #endif /* DEBUGGING_MSTATS */ } -#endif /* lint */ #ifdef USE_PERL_SBRK @@ -2557,3 +2570,13 @@ Perl_sbrk(int size) } #endif /* ! defined USE_PERL_SBRK */ + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */