From: Ilya Zakharevich Date: Sat, 20 Jun 1998 04:29:00 +0000 (-0400) Subject: Cosmetic malloc patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fa423c5bdc4b72005f8624af7825acfbde0c572e;p=p5sagit%2Fp5-mst-13.2.git Cosmetic malloc patch Message-Id: <199806200829.EAA13974@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@1176 --- diff --git a/malloc.c b/malloc.c index 2cbdcfd..91815a2 100644 --- a/malloc.c +++ b/malloc.c @@ -754,6 +754,184 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size) return NULL; } +static union overhead * +getpages(int 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; + + if (sbrk_good > 0) { + if (!last_sbrk_top && require < FIRST_SBRK) + require = FIRST_SBRK; + else if (require < MIN_SBRK) require = MIN_SBRK; + + if (require < goodsbrk * MIN_SBRK_FRAC / 100) + require = goodsbrk * MIN_SBRK_FRAC / 100; + require = ((require - 1 + MIN_SBRK) / MIN_SBRK) * MIN_SBRK; + } else { + require = needed; + last_sbrk_top = 0; + sbrked_remains = 0; + } + + DEBUG_m(PerlIO_printf(Perl_debug_log, + "sbrk(%ld) for %ld-byte-long arena\n", + (long)require, (long) needed)); + cp = (char *)sbrk(require); +#ifdef DEBUGGING_MSTATS + sbrks++; +#endif + if (cp == last_sbrk_top) { + /* Common case, anything is fine. */ + sbrk_good++; + ovp = (union overhead *) (cp - sbrked_remains); + sbrked_remains = require - (needed - sbrked_remains); + } else if (cp == (char *)-1) { /* no more room! */ + ovp = (union overhead *)emergency_sbrk(needed); + if (ovp == (union overhead *)-1) + return 0; + return ovp; + } else { /* Non-continuous or first sbrk(). */ + long add = sbrked_remains; + char *newcp; + + if (sbrked_remains) { /* Put rest into chain, we + cannot use it right now. */ + add_to_chain((void*)(last_sbrk_top - sbrked_remains), + sbrked_remains, 0); + } + + /* Second, check alignment. */ + slack = 0; + +#ifndef atarist /* on the atari we dont have to worry about this */ +# ifndef I286 /* The sbrk(0) call on the I286 always returns the next segment */ + + /* CHUNK_SHIFT is 1 for PACK_MALLOC, 0 otherwise. */ + if ((UV)cp & (0x7FF >> CHUNK_SHIFT)) { /* Not aligned. */ + slack = (0x800 >> CHUNK_SHIFT) + - ((UV)cp & (0x7FF >> CHUNK_SHIFT)); + add += slack; + } +# endif +#endif /* atarist */ + + if (add) { + DEBUG_m(PerlIO_printf(Perl_debug_log, + "sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignement,\t%ld were assumed to come from the tail of the previous sbrk\n", + (long)add, (long) slack, + (long) sbrked_remains)); + newcp = (char *)sbrk(add); +#if defined(DEBUGGING_MSTATS) + sbrks++; + sbrk_slack += add; +#endif + if (newcp != cp + require) { + /* Too bad: even rounding sbrk() is not continuous.*/ + DEBUG_m(PerlIO_printf(Perl_debug_log, + "failed to fix bad sbrk()\n")); +#ifdef PACK_MALLOC + if (slack) { + MUTEX_UNLOCK(&malloc_mutex); + croak("%s", "panic: Off-page sbrk"); + } +#endif + if (sbrked_remains) { + /* Try again. */ +#if defined(DEBUGGING_MSTATS) + sbrk_slack += require; +#endif + require = needed; + DEBUG_m(PerlIO_printf(Perl_debug_log, + "straight sbrk(%ld)\n", + (long)require)); + cp = (char *)sbrk(require); +#ifdef DEBUGGING_MSTATS + sbrks++; +#endif + if (cp == (char *)-1) + return 0; + } + sbrk_good = -1; /* Disable optimization! + Continue with not-aligned... */ + } else { + cp += slack; + require += sbrked_remains; + } + } + + if (last_sbrk_top) { + sbrk_good -= SBRK_FAILURE_PRICE; + } + + ovp = (union overhead *) cp; + /* + * Round up to minimum allocation size boundary + * and deduct from block count to reflect. + */ + +#ifndef I286 /* Again, this should always be ok on an 80286 */ + if ((UV)ovp & 7) { + ovp = (union overhead *)(((UV)ovp + 8) & ~7); + DEBUG_m(PerlIO_printf(Perl_debug_log, + "fixing sbrk(): %d bytes off machine alignement\n", + (int)((UV)ovp & 7))); + (*nblksp)--; +# if defined(DEBUGGING_MSTATS) + /* This is only approx. if TWO_POT_OPTIMIZE: */ + sbrk_slack += (1 << bucket); +# endif + } +#endif + sbrked_remains = require - needed; + } + last_sbrk_top = cp + require; + last_op = (char*) cp; +#ifdef DEBUGGING_MSTATS + goodsbrk += require; +#endif + return ovp; +} + +static int +getpages_adjacent(int require) +{ + if (require <= sbrked_remains) { + sbrked_remains -= require; + } else { + char *cp; + + require -= sbrked_remains; + /* We do not try to optimize sbrks here, we go for place. */ + cp = (char*) sbrk(require); +#ifdef DEBUGGING_MSTATS + sbrks++; + goodsbrk += require; +#endif + if (cp == last_sbrk_top) { + sbrked_remains = 0; + last_sbrk_top = cp + require; + } else { + /* Report the failure: */ + if (sbrked_remains) + add_to_chain((void*)(last_sbrk_top - sbrked_remains), + sbrked_remains, 0); + add_to_chain((void*)cp, require, 0); + sbrk_good -= SBRK_FAILURE_PRICE; + sbrked_remains = 0; + last_sbrk_top = 0; + last_op = 0; + return 0; + } + } + + return 1; +} + /* * Allocate more memory to the indicated bucket. */ @@ -762,9 +940,8 @@ morecore(register int bucket) { register union overhead *ovp; register int rnu; /* 2^rnu bytes will be requested */ - register int nblks; /* become nblks blocks of the desired size */ + int nblks; /* become nblks blocks of the desired size */ register MEM_SIZE siz, needed; - int slack = 0; if (nextf[bucket]) return; @@ -807,145 +984,12 @@ morecore(register int bucket) ovp = (union overhead *)(last_sbrk_top - sbrked_remains); sbrked_remains -= needed; last_op = (char*)ovp; - } else { - /* Need to do (possibly expensive) system call. Try to - optimize it for rare calling. */ - MEM_SIZE require = needed - sbrked_remains; - char *cp; - - if (sbrk_good > 0) { - if (!last_sbrk_top && require < FIRST_SBRK) - require = FIRST_SBRK; - else if (require < MIN_SBRK) require = MIN_SBRK; - - if (require < goodsbrk * MIN_SBRK_FRAC / 100) - require = goodsbrk * MIN_SBRK_FRAC / 100; - require = ((require - 1 + MIN_SBRK) / MIN_SBRK) * MIN_SBRK; - } else { - require = needed; - last_sbrk_top = 0; - sbrked_remains = 0; - } + } else + ovp = getpages(needed, &nblks, bucket); - DEBUG_m(PerlIO_printf(Perl_debug_log, - "sbrk(%ld) for %ld-byte-long arena\n", - (long)require, (long) needed)); - cp = (char *)sbrk(require); -#ifdef DEBUGGING_MSTATS - sbrks++; -#endif - if (cp == last_sbrk_top) { - /* Common case, anything is fine. */ - sbrk_good++; - ovp = (union overhead *) (cp - sbrked_remains); - sbrked_remains = require - (needed - sbrked_remains); - } else if (cp == (char *)-1) { /* no more room! */ - ovp = (union overhead *)emergency_sbrk(needed); - if (ovp == (union overhead *)-1) - return; - goto gotit; - } else { /* Non-continuous or first sbrk(). */ - long add = sbrked_remains; - char *newcp; - - if (sbrked_remains) { /* Put rest into chain, we - cannot use it right now. */ - add_to_chain((void*)(last_sbrk_top - sbrked_remains), - sbrked_remains, 0); - } - - /* Second, check alignment. */ - slack = 0; - -#ifndef atarist /* on the atari we dont have to worry about this */ -# ifndef I286 /* The sbrk(0) call on the I286 always returns the next segment */ + if (!ovp) + return; - /* CHUNK_SHIFT is 1 for PACK_MALLOC, 0 otherwise. */ - if ((UV)cp & (0x7FF >> CHUNK_SHIFT)) { /* Not aligned. */ - slack = (0x800 >> CHUNK_SHIFT) - - ((UV)cp & (0x7FF >> CHUNK_SHIFT)); - add += slack; - } -# endif -#endif /* atarist */ - - if (add) { - DEBUG_m(PerlIO_printf(Perl_debug_log, -"sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignement,\t%ld were assumed to come from the tail of the previous sbrk\n", - (long)add, (long) slack, - (long) sbrked_remains)); - newcp = (char *)sbrk(add); -#if defined(DEBUGGING_MSTATS) - sbrks++; - sbrk_slack += add; -#endif - if (newcp != cp + require) { - /* Too bad: even rounding sbrk() is not continuous.*/ - DEBUG_m(PerlIO_printf(Perl_debug_log, - "failed to fix bad sbrk()\n")); -#ifdef PACK_MALLOC - if (slack) { - MUTEX_UNLOCK(&malloc_mutex); - croak("%s", "panic: Off-page sbrk"); - } -#endif - if (sbrked_remains) { - /* Try again. */ -#if defined(DEBUGGING_MSTATS) - sbrk_slack += require; -#endif - require = needed; - DEBUG_m(PerlIO_printf(Perl_debug_log, - "straight sbrk(%ld)\n", - (long)require)); - cp = (char *)sbrk(require); -#ifdef DEBUGGING_MSTATS - sbrks++; -#endif - if (cp == (char *)-1) - return; - } - sbrk_good = -1; /* Disable optimization! - Continue with not-aligned... */ - } else { - cp += slack; - require += sbrked_remains; - } - } - - if (last_sbrk_top) { - sbrk_good -= SBRK_FAILURE_PRICE; - } - - ovp = (union overhead *) cp; - /* - * Round up to minimum allocation size boundary - * and deduct from block count to reflect. - */ - -#ifndef I286 /* Again, this should always be ok on an 80286 */ - if ((UV)ovp & 7) { - ovp = (union overhead *)(((UV)ovp + 8) & ~7); - DEBUG_m(PerlIO_printf(Perl_debug_log, - "fixing sbrk(): %d bytes off machine alignement\n", - (int)((UV)ovp & 7))); - nblks--; -# if defined(DEBUGGING_MSTATS) - /* This is only approx. if TWO_POT_OPTIMIZE: */ - sbrk_slack += (1 << bucket); -# endif - } -#endif - sbrked_remains = require - needed; - } - last_sbrk_top = cp + require; - last_op = (char*) cp; -#ifdef DEBUGGING_MSTATS - goodsbrk += require; -#endif - } - - gotit: /* * Add new memory allocated to that on * free list for this hash bucket. @@ -1207,41 +1251,15 @@ realloc(void *mp, size_t nbytes) newarena = (1 << pow) + POW2_OPTIMIZE_SURPLUS(pow * BUCKETS_PER_POW2); require = newarena - onb - M_OVERHEAD; - if (require <= sbrked_remains) { - sbrked_remains -= require; - } else { - char *cp; - - require -= sbrked_remains; - /* We do not try to optimize sbrks here, we go for place. */ - cp = (char*) sbrk(require); -#ifdef DEBUGGING_MSTATS - sbrks++; - goodsbrk += require; -#endif - if (cp == last_sbrk_top) { - sbrked_remains = 0; - last_sbrk_top = cp + require; - } else { - /* Report the failure: */ - if (sbrked_remains) - add_to_chain((void*)(last_sbrk_top - sbrked_remains), - sbrked_remains, 0); - add_to_chain((void*)cp, require, 0); - sbrk_good -= SBRK_FAILURE_PRICE; - sbrked_remains = 0; - last_sbrk_top = 0; - last_op = 0; - goto hard_way; - } - } - + if (getpages_adjacent(require)) { #ifdef DEBUGGING_MSTATS - nmalloc[bucket]--; - nmalloc[pow * BUCKETS_PER_POW2]++; + nmalloc[bucket]--; + nmalloc[pow * BUCKETS_PER_POW2]++; #endif - *(cp - M_OVERHEAD) = pow * BUCKETS_PER_POW2; /* Fill index. */ - goto inplace_label; + *(cp - M_OVERHEAD) = pow * BUCKETS_PER_POW2; /* Fill index. */ + goto inplace_label; + } else + goto hard_way; } else { hard_way: MUTEX_UNLOCK(&malloc_mutex);