From: Jarkko Hietaniemi Date: Sun, 10 Jul 2005 21:50:27 +0000 (+0300) Subject: yet another way of debugging memory allocations X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=46c6c7e2a233df6079f4ba33374086db68feb889;p=p5sagit%2Fp5-mst-13.2.git yet another way of debugging memory allocations Message-ID: <42D16DF3.4040806@gmail.com> tweak PERL_MEM_LOG p4raw-id: //depot/perl@25109 --- diff --git a/handy.h b/handy.h index a89f09e..8cddbab 100644 --- a/handy.h +++ b/handy.h @@ -87,6 +87,19 @@ Null SV pointer. # define HAS_BOOL 1 #endif +/* Try to figure out __func__ or __FUNCTION__ equivalent, if any. + * XXX Should really be a Configure probe. */ +#if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined(__SUNPRO_C)) /* C99 or close enough. */ +# define FUNCTION__ __func__ +#else +# if (defined(_MSC_VER) && _MSC_VER < 1300) || /* Pre-MSVC 7.0 has neither __func__ nor __FUNCTION and no good workarounds, either. */ \ + (defined(__DECC_VER)) /* Tru64 or VMS, and strict C89 being used. */ +# define FUNCTION__ "" +# else +# define FUNCTION__ __FUNCTION__ /* Common extension. */ +# endif +#endif + /* XXX A note on the perl source internal type system. The original intent was that I32 be *exactly* 32 bits. @@ -624,15 +637,48 @@ hopefully catches attempts to access uninitialized memory. #endif #ifdef PERL_MEM_LOG -Malloc_t Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber); -Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber); -Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber); +/* + * If PERL_MEM_LOG is defined, all New()s, Renew()s, and Safefree()s + * go through functions, which are handy for debugging breakpoints, but + * which more importantly get the immediate calling environment (file and + * line number) passed in. This can then be used for logging the calls, + * for which one can get a sample implementation if PERL_MEM_LOG_STDERR + * is defined. + * + * Known problems: + * - all memory allocs do not get logged, only those + * that go through Newx() and derivatives (while all + * Safefrees do get logged) + * - __FILE__ and __LINE__ do not work everywhere + * - __func__ or __FUNCTION__ even less so + * - I think more goes on after the perlio frees but + * the thing is that STDERR gets closed (as do all + * the file descriptors) + * - no deeper calling stack than the caller of the Newx() + * or the kind, but do I look like a C reflection/introspection + * utility to you? + * - the function prototypes for the logging functions + * probably should maybe be somewhere else than handy.h + * - one could consider inlining (macrofying) the logging + * for speed, but I am too lazy + * - one could imagine recording the allocations in a hash, + * (keyed by the allocation address?), and maintain that + * through reallocs and frees, but how to do that without + * any News() happening...? + */ + +Malloc_t Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname); + +Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname); + +Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname); + #endif #ifdef PERL_MEM_LOG -#define MEM_LOG_ALLOC(n,t,a) Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__) -#define MEM_LOG_REALLOC(n,t,v,a) Perl_mem_log_realloc(n,sizeof(t),STRINGIFY(t),v,a,__FILE__,__LINE__) -#define MEM_LOG_FREE(a) Perl_mem_log_free(a,__FILE__,__LINE__) +#define MEM_LOG_ALLOC(n,t,a) Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__,FUNCTION__) +#define MEM_LOG_REALLOC(n,t,v,a) Perl_mem_log_realloc(n,sizeof(t),STRINGIFY(t),v,a,__FILE__,__LINE__,FUNCTION__) +#define MEM_LOG_FREE(a) Perl_mem_log_free(a,__FILE__,__LINE__,FUNCTION__) #endif #ifndef MEM_LOG_ALLOC diff --git a/pod/perlhack.pod b/pod/perlhack.pod index f90c48b..31dab0e 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -2468,6 +2468,15 @@ memory usage, so it shouldn't be used in production environments. It also converts C from a macro into a real function, so you can use your favourite debugger to discover where those pesky SVs were allocated. +=head2 PERL_MEM_LOG + +If compiled with C<-DPERL_MEM_LOG>, all New() and Renew() allocations +and Safefree() in the Perl core go through logging functions, which is +handy for breakpoint setting. If also compiled with C<-DPERL_MEM_LOG_STDERR>, +the allocations and frees are logged to STDERR in these logging functions, +with the calling source code file and line number (and C function name, +if supported by the C compiler). + =head2 Profiling Depending on your platform there are various of profiling Perl. diff --git a/util.c b/util.c index 8a04991..6caedaa 100644 --- a/util.c +++ b/util.c @@ -4961,42 +4961,43 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp) #ifdef PERL_MEM_LOG Malloc_t -Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber) +Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname) { #ifdef PERL_MEM_LOG_STDERR /* We can't use PerlIO_printf() for obvious reasons. */ char buf[1024]; sprintf(buf, - "alloc: %s:%d: %"IVdf" %"UVuf" %s = %"IVdf": %p\n", - filename, linenumber, - n, typesize, typename, n * typesize, newalloc); + "alloc: %s:%d:%s: %"IVdf" %"UVuf" %s = %"IVdf": %"UVxf"\n", + filename, linenumber, funcname, + n, typesize, typename, n * typesize, PTR2UV(newalloc)); write(2, buf, strlen(buf)); #endif return newalloc; } Malloc_t -Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber) +Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname) { #ifdef PERL_MEM_LOG_STDERR /* We can't use PerlIO_printf() for obvious reasons. */ char buf[1024]; sprintf(buf, - "realloc: %s:%d: %"IVdf" %"UVuf" %s = %"IVdf": %p -> %p\n", - filename, linenumber, - n, typesize, typename, n * typesize, oldalloc, newalloc); + "realloc: %s:%d:%s: %"IVdf" %"UVuf" %s = %"IVdf": %"UVxf" -> %"UVxf"\n", + filename, linenumber, funcname, + n, typesize, typename, n * typesize, PTR2UV(oldalloc), PTR2UV(newalloc)); write(2, buf, strlen(buf)); #endif return newalloc; } Malloc_t -Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber) +Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname) { #ifdef PERL_MEM_LOG_STDERR /* We can't use PerlIO_printf() for obvious reasons. */ char buf[1024]; - sprintf(buf, "free: %s:%d: %p\n", filename, linenumber, oldalloc); + sprintf(buf, "free: %s:%d:%s: %"UVxf"\n", + filename, linenumber, funcname, PTR2UV(oldalloc)); write(2, buf, strlen(buf)); #endif return oldalloc;