From: Ilya Zakharevich Date: Wed, 1 Nov 2000 23:39:56 +0000 (-0500) Subject: better messages from malloc() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b022d2d27f9b150bfa61c150f89ab4147aeb4595;p=p5sagit%2Fp5-mst-13.2.git better messages from malloc() Message-ID: <20001101233956.A520@monk.mps.ohio-state.edu> p4raw-id: //depot/perl@7533 --- diff --git a/malloc.c b/malloc.c index 7584000..fc37cb2 100644 --- a/malloc.c +++ b/malloc.c @@ -146,9 +146,15 @@ # Fatal error reporting function croak(format, arg) warn(idem) + exit(1) + # Fatal error reporting function + croak2(format, arg1, arg2) warn2(idem) + exit(1) + # Error reporting function warn(format, arg) fprintf(stderr, idem) + # Error reporting function + warn2(format, arg1, arg2) fprintf(stderr, idem) + # Locking/unlocking for MT operation MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex) MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex) @@ -234,7 +240,12 @@ # include "perl.h" # if defined(PERL_IMPLICIT_CONTEXT) # define croak Perl_croak_nocontext +# define croak2 Perl_croak_nocontext # define warn Perl_warn_nocontext +# define warn2 Perl_warn_nocontext +# else +# define croak2 croak +# define warn2 warn # endif #else # ifdef PERL_FOR_X2P @@ -274,9 +285,15 @@ # ifndef croak /* make depend */ # define croak(mess, arg) (warn((mess), (arg)), exit(1)) # endif +# ifndef croak2 /* make depend */ +# define croak2(mess, arg1, arg2) (warn2((mess), (arg1), (arg2)), exit(1)) +# endif # ifndef warn # define warn(mess, arg) fprintf(stderr, (mess), (arg)) # endif +# ifndef warn +# define warn2(mess, arg1) fprintf(stderr, (mess), (arg1), (arg2)) +# endif # ifdef DEBUG_m # undef DEBUG_m # endif @@ -851,18 +868,64 @@ static int getpages_adjacent(MEM_SIZE require); # define MUTEX_UNLOCK(m) STMT_START { if (*m) mutex_unlock(*m); } STMT_END #endif +#ifndef BITS_IN_PTR +# define BITS_IN_PTR (8*PTRSIZE) +#endif + +/* + * nextf[i] is the pointer to the next free block of size 2^i. The + * smallest allocatable block is 8 bytes. The overhead information + * precedes the data area returned to the user. + */ +#define NBUCKETS (BITS_IN_PTR*BUCKETS_PER_POW2 + 1) +static union overhead *nextf[NBUCKETS]; + +#if defined(PURIFY) && !defined(USE_PERL_SBRK) +# define USE_PERL_SBRK +#endif + +#ifdef USE_PERL_SBRK +#define sbrk(a) Perl_sbrk(a) +Malloc_t Perl_sbrk (int size); +#else +#ifdef DONT_DECLARE_STD +#ifdef I_UNISTD +#include +#endif +#else +extern Malloc_t sbrk(int); +#endif +#endif + +#ifdef DEBUGGING_MSTATS +/* + * nmalloc[i] is the difference between the number of mallocs and frees + * for a given block size. + */ +static u_int nmalloc[NBUCKETS]; +static u_int sbrk_slack; +static u_int start_slack; +#else /* !( defined DEBUGGING_MSTATS ) */ +# define sbrk_slack 0 +#endif + +static u_int goodsbrk; + static char *emergency_buffer; static MEM_SIZE emergency_buffer_size; +static int no_mem; /* 0 if the last request for more memory succeeded. + Otherwise the size of the failing request. */ static Malloc_t emergency_sbrk(MEM_SIZE size) { MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<= BIG_SIZE) { - /* Give the possibility to recover: */ + if (size >= BIG_SIZE && (!no_mem || (size < no_mem))) { + /* Give the possibility to recover, but avoid an infinite cycle. */ MALLOC_UNLOCK; - croak("Out of memory during \"large\" request for %i bytes", size); + no_mem = size; + croak2("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) { @@ -910,7 +973,7 @@ emergency_sbrk(MEM_SIZE size) } do_croak: MALLOC_UNLOCK; - croak("Out of memory during request for %i bytes", size); + croak("Out of memory during request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack)); /* NOTREACHED */ return Nullch; } @@ -919,47 +982,6 @@ emergency_sbrk(MEM_SIZE size) # define emergency_sbrk(size) -1 #endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */ -#ifndef BITS_IN_PTR -# define BITS_IN_PTR (8*PTRSIZE) -#endif - -/* - * nextf[i] is the pointer to the next free block of size 2^i. The - * smallest allocatable block is 8 bytes. The overhead information - * precedes the data area returned to the user. - */ -#define NBUCKETS (BITS_IN_PTR*BUCKETS_PER_POW2 + 1) -static union overhead *nextf[NBUCKETS]; - -#if defined(PURIFY) && !defined(USE_PERL_SBRK) -# define USE_PERL_SBRK -#endif - -#ifdef USE_PERL_SBRK -#define sbrk(a) Perl_sbrk(a) -Malloc_t Perl_sbrk (int size); -#else -#ifdef DONT_DECLARE_STD -#ifdef I_UNISTD -#include -#endif -#else -extern Malloc_t sbrk(int); -#endif -#endif - -#ifdef DEBUGGING_MSTATS -/* - * nmalloc[i] is the difference between the number of mallocs and frees - * for a given block size. - */ -static u_int nmalloc[NBUCKETS]; -static u_int sbrk_slack; -static u_int start_slack; -#endif - -static u_int goodsbrk; - #ifdef DEBUGGING #undef ASSERT #define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p)); else @@ -1035,7 +1057,28 @@ Perl_malloc(register size_t nbytes) { dTHX; if (!PL_nomemok) { - PerlIO_puts(PerlIO_stderr(),"Out of memory!\n"); + char buff[80]; + char *eb = buff + sizeof(buff) - 1; + char *s = eb; + size_t n = nbytes; + + PerlIO_puts(PerlIO_stderr(),"Out of memory during request for "); +#if defined(DEBUGGING) || defined(RCHECK) + n = size; +#endif + *s = 0; + do { + *--s = '0' + (n % 10); + } while (n /= 10); + PerlIO_puts(PerlIO_stderr(),s); + PerlIO_puts(PerlIO_stderr()," bytes, total sbrk() is "); + s = eb; + n = goodsbrk + sbrk_slack; + do { + *--s = '0' + (n % 10); + } while (n /= 10); + PerlIO_puts(PerlIO_stderr(),s); + PerlIO_puts(PerlIO_stderr()," bytes!\n"); my_exit(1); } } @@ -1343,6 +1386,7 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) sbrked_remains = require - needed; last_op = cp; } + no_mem = 0; last_sbrk_top = cp + require; #ifdef DEBUGGING_MSTATS goodsbrk += require; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 1be2bc5..452938c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2329,7 +2329,8 @@ The request was judged to be small, so the possibility to trap it depends on the way perl was compiled. By default it is not trappable. However, if compiled for this, Perl may use the contents of C<$^M> as an emergency pool after die()ing with this message. In this case the error -is trappable I. +is trappable I, and the error message will include the line and file +where the failed request happened. =item Out of memory during ridiculously large request