X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=734ea066e8853e747e1d0f44253593bb06861453;hb=140554665c10264faba3f60819106d3921665365;hp=450142d452bb6fde379ddc2569a9ef86ad171562;hpb=4ad56ec9b035a619c0146fe1a32bb4d485c6c580;p=p5sagit%2Fp5-mst-13.2.git diff --git a/malloc.c b/malloc.c index 450142d..734ea06 100644 --- a/malloc.c +++ b/malloc.c @@ -900,6 +900,8 @@ emergency_sbrk(MEM_SIZE size) do_croak: MALLOC_UNLOCK; croak("Out of memory during request for %i bytes", size); + /* NOTREACHED */ + return Nullch; } #else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */ @@ -945,6 +947,7 @@ static u_int goodsbrk; static void botch(char *diag, char *s) { + dTHXo; PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s); PerlProc_abort(); } @@ -1022,15 +1025,18 @@ Perl_malloc(register size_t nbytes) } DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) malloc %ld bytes\n", - (unsigned long)(p+1), (unsigned long)(PL_an++), + "0x%"UVxf": (%05lu) malloc %ld bytes\n", + PTR2UV(p+1), (unsigned long)(PL_an++), (long)size)); /* remove from linked list */ #if defined(RCHECK) - if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) - PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n", - (unsigned long)*((int*)p),(unsigned long)p); + if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) { + dTHXo; + PerlIO_printf(PerlIO_stderr(), + "Corrupt malloc ptr 0x%lx at 0x%"UVxf"\n", + (unsigned long)*((int*)p),PTR2UV(p)); + } #endif nextf[bucket] = p->ov_next; @@ -1470,8 +1476,8 @@ Perl_mfree(void *mp) #endif DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) free\n", - (unsigned long)cp, (unsigned long)(PL_an++))); + "0x%"UVxf": (%05lu) free\n", + PTR2UV(cp), (unsigned long)(PL_an++))); if (cp == NULL) return; @@ -1489,6 +1495,7 @@ Perl_mfree(void *mp) { static int bad_free_warn = -1; if (bad_free_warn == -1) { + dTHXo; char *pbf = PerlEnv_getenv("PERL_BADFREE"); bad_free_warn = (pbf) ? atoi(pbf) : 1; } @@ -1570,11 +1577,12 @@ Perl_realloc(void *mp, size_t nbytes) { static int bad_free_warn = -1; if (bad_free_warn == -1) { + dTHXo; char *pbf = PerlEnv_getenv("PERL_BADFREE"); bad_free_warn = (pbf) ? atoi(pbf) : 1; } if (!bad_free_warn) - return; + return Nullch; #ifdef RCHECK warn("%srealloc() %signored", (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "), @@ -1582,7 +1590,7 @@ Perl_realloc(void *mp, size_t nbytes) #else warn("%s", "Bad realloc() ignored"); #endif - return; /* sanity */ + return Nullch; /* sanity */ } onb = BUCKET_SIZE_REAL(bucket); @@ -1654,8 +1662,8 @@ Perl_realloc(void *mp, size_t nbytes) #endif res = cp; DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) realloc %ld bytes inplace\n", - (unsigned long)res,(unsigned long)(PL_an++), + "0x%"UVxf": (%05lu) realloc %ld bytes inplace\n", + PTR2UV(res),(unsigned long)(PL_an++), (long)size)); } else if (incr == 1 && (cp - M_OVERHEAD == last_op) && (onb > (1 << LOG_OF_MIN_ARENA))) { @@ -1690,8 +1698,8 @@ Perl_realloc(void *mp, size_t nbytes) } else { hard_way: DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) realloc %ld bytes the hard way\n", - (unsigned long)cp,(unsigned long)(PL_an++), + "0x%"UVxf": (%05lu) realloc %ld bytes the hard way\n", + PTR2UV(cp),(unsigned long)(PL_an++), (long)size)); if ((res = (char*)Perl_malloc(nbytes)) == NULL) return (NULL); @@ -1836,49 +1844,49 @@ Perl_dump_mstats(pTHX_ char *s) } MALLOC_UNLOCK; if (s) - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n", s, (long)BUCKET_SIZE_REAL(MIN_BUCKET), (long)BUCKET_SIZE(MIN_BUCKET), (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket)); - PerlIO_printf(PerlIO_stderr(), "%8d free:", totfree); + PerlIO_printf(Perl_error_log, "%8d free:", totfree); for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nfree[i]); } #ifdef BUCKETS_ROOT2 - PerlIO_printf(PerlIO_stderr(), "\n\t "); + PerlIO_printf(Perl_error_log, "\n\t "); for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nfree[i]); } #endif - PerlIO_printf(PerlIO_stderr(), "\n%8d used:", total - totfree); + PerlIO_printf(Perl_error_log, "\n%8d used:", total - totfree); for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nmalloc[i] - nfree[i]); } #ifdef BUCKETS_ROOT2 - PerlIO_printf(PerlIO_stderr(), "\n\t "); + PerlIO_printf(Perl_error_log, "\n\t "); for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nmalloc[i] - nfree[i]); } #endif - PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n", + PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n", goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack, start_slack, total_chain, sbrked_remains); #endif /* DEBUGGING_MSTATS */ @@ -1962,8 +1970,8 @@ Perl_sbrk(int size) } } - DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n", - size, reqsize, Perl_sbrk_oldsize, got)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"UVxf"\n", + size, reqsize, Perl_sbrk_oldsize, PTR2UV(got))); return (void *)got; }