X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=ae0adace269aa883a5c4ac83111f81d650276b0a;hb=8f94de01b0ec23d3da0be11e7e9ccad913e01fae;hp=0f668cdfcb75872d4f4ce5eeddb6a9ee73e11b35;hpb=3f270f98f93055407790f4fc65bd60980f2723b2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/malloc.c b/malloc.c index 0f668cd..ae0adac 100644 --- a/malloc.c +++ b/malloc.c @@ -3,6 +3,10 @@ */ /* + * "'The Chamber of Records,' said Gimli. 'I guess that is where we now stand.'" + */ + +/* Here are some notes on configuring Perl's malloc. (For non-perl usage see below.) @@ -255,7 +259,6 @@ # include # include # include -# define _(arg) arg # ifndef Malloc_t # define Malloc_t void * # endif @@ -304,7 +307,11 @@ # ifndef pTHX # define pTHX void # define pTHX_ -# define dTHX extern int Perl___notused +# ifdef HASATTRIBUTE +# define dTHX extern int Perl___notused PERL_UNUSED_DECL +# else +# define dTHX extern int Perl___notused +# endif # define WITH_THX(s) s # endif # ifndef PERL_GET_INTERP @@ -351,7 +358,7 @@ # undef DEBUG_m # define DEBUG_m(a) \ STMT_START { \ - if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } } \ + if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) { a; } } \ } STMT_END #endif @@ -1041,7 +1048,9 @@ Perl_malloc(register size_t nbytes) POW2_OPTIMIZE_ADJUST(nbytes); nbytes += M_OVERHEAD; nbytes = (nbytes + 3) &~ 3; +#if defined(PACK_MALLOC) && !defined(SMALL_BUCKET_VIA_TABLE) do_shifts: +#endif shiftr = (nbytes - 1) >> START_SHIFT; bucket = START_SHIFTS_BUCKET; /* apart from this loop, this is O(1) */ @@ -1096,7 +1105,7 @@ Perl_malloc(register size_t nbytes) DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05lu) malloc %ld bytes\n", - PTR2UV(p+1), (unsigned long)(PL_an++), + PTR2UV(p), (unsigned long)(PL_an++), (long)size)); /* remove from linked list */ @@ -1586,12 +1595,12 @@ Perl_mfree(void *mp) { dTHX; if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored", + Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored (RMAGIC, PERL_CORE)", ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad"); } #else - warn("%s free() ignored", + warn("%s free() ignored (RMAGIC)", ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad"); #endif #else @@ -1599,7 +1608,7 @@ Perl_mfree(void *mp) { dTHX; if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC)) - Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored"); + Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored (PERL_CORE)"); } #else warn("%s", "Bad free() ignored");