From 73d1d97336c68e0f5b29937cb9347a00df4c645c Mon Sep 17 00:00:00 2001 From: Jim Cromie Date: Thu, 11 Jun 2009 16:28:46 -0600 Subject: [PATCH] invert and rename PERL_MEM_LOG_STDERR to PERL_MEM_LOG_NOIMPL Most users who want PERL_MEM_LOG want the default implementation, give it to them. Users providing their own implementation can obtain current behavior by adding -DPERL_MEM_LOG_NOIMPL. Frankly, the average user probably wants _ENV by default too. --- embed.fnc | 2 +- handy.h | 6 ++-- util.c | 104 ++++++++++++++++++++++++++++++++++++++++---------------------- 3 files changed, 72 insertions(+), 40 deletions(-) diff --git a/embed.fnc b/embed.fnc index 08f7725..ae5c9f6 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1834,7 +1834,7 @@ s |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \ s |bool |vdie_common |NULLOK const char *message|STRLEN msglen\ |I32 utf8|bool warn sr |char * |write_no_mem -#if defined(PERL_MEM_LOG) && defined(PERL_MEM_LOG_STDERR) +#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL) sn |void |mem_log_common |enum mem_log_type mlt|const UV n|const UV typesize \ |NN const char *type_name|NULLOK const SV *sv \ |Malloc_t oldalloc|Malloc_t newalloc \ diff --git a/handy.h b/handy.h index 9e8f50a..d890f70 100644 --- a/handy.h +++ b/handy.h @@ -761,7 +761,7 @@ PoisonWith(0xEF) for catching access to freed memory. * which more importantly get the immediate calling environment (file and * line number, and C function name if available) passed in. This info can * then be used for logging the calls, for which one gets a sample - * implementation if PERL_MEM_LOG_STDERR is defined. + * implementation unless -DPERL_MEM_LOG_NOIMPL is also defined. * * Known problems: * - all memory allocs do not get logged, only those @@ -783,6 +783,8 @@ PoisonWith(0xEF) for catching access to freed memory. * (keyed by the allocation address?), and maintain that * through reallocs and frees, but how to do that without * any News() happening...? + * - lots of -Ddefines to get useful/controllable output + * - lots of ENV reads when you get control -DPERL_MEM_LOG_ENV* */ PERL_EXPORT_C Malloc_t Perl_mem_log_alloc(const UV n, const UV typesize, const char *type_name, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname); @@ -792,7 +794,7 @@ PERL_EXPORT_C Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const PERL_EXPORT_C Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname); # ifdef PERL_CORE -# ifdef PERL_MEM_LOG_STDERR +# ifndef PERL_MEM_LOG_NOIMPL enum mem_log_type { MLT_ALLOC, MLT_REALLOC, diff --git a/util.c b/util.c index 469a9da..2220618 100644 --- a/util.c +++ b/util.c @@ -5472,37 +5472,39 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp) #ifdef PERL_MEM_LOG /* - * PERL_MEM_LOG: the Perl_mem_log_..() will be compiled. + * -DPERL_MEM_LOG: the Perl_mem_log_..() is compiled, including the + * the default implementation, unless -DPERL_MEM_LOG_NOIMPL is also + * given, and you supply your own implementation. * - * PERL_MEM_LOG_ENV: if defined, during run time the environment - * variables PERL_MEM_LOG and PERL_SV_LOG will be consulted, and - * if the integer value of that is true, the logging will happen. - * (The default is to always log if the PERL_MEM_LOG define was - * in effect.) + * -DPERL_MEM_LOG_ENV: if compiled in, at run time the environment + * variables PERL_MEM_LOG and PERL_SV_LOG are checked (repeatedly). + * If the integer values are true, the respective logging is done. + * (Without this also defined, logging is voluminous) * - * PERL_MEM_LOG_TIMESTAMP: if defined, a timestamp will be logged + * -DPERL_MEM_LOG_TIMESTAMP: if compiled, a timestamp will be logged * before every memory logging entry. This can be turned off at run * time by setting the environment variable PERL_MEM_LOG_TIMESTAMP * to zero. */ /* - * PERL_MEM_LOG_SPRINTF_BUF_SIZE: size of a (stack-allocated) buffer + * -DPERL_MEM_LOG_SPRINTF_BUF_SIZE=X: size of a (stack-allocated) buffer * the Perl_mem_log_...() will use (either via sprintf or snprintf). */ #define PERL_MEM_LOG_SPRINTF_BUF_SIZE 128 /* - * PERL_MEM_LOG_FD: the file descriptor the Perl_mem_log_...() will - * log to. You can also define in compile time PERL_MEM_LOG_ENV_FD, - * in which case the environment variable PERL_MEM_LOG_FD will be - * consulted for the file descriptor number to use. + * -DPERL_MEM_LOG_FD=2: the file descriptor the Perl_mem_log_...() + * writes to. You can also define in compile time + * PERL_MEM_LOG_ENV_FD, in which case the environment variable + * PERL_MEM_LOG_FD will be consulted for the file descriptor number to + * use. */ #ifndef PERL_MEM_LOG_FD # define PERL_MEM_LOG_FD 2 /* If STDERR is too boring for you. */ #endif -#ifdef PERL_MEM_LOG_STDERR +#ifndef PERL_MEM_LOG_NOIMPL # ifdef DEBUG_LEAKING_SCALARS # define SV_LOG_SERIAL_FMT " [%lu]" @@ -5513,13 +5515,17 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp) # endif static void -S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const char *type_name, const SV *sv, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname) +S_mem_log_common(enum mem_log_type mlt, const UV n, + const UV typesize, const char *type_name, const SV *sv, + Malloc_t oldalloc, Malloc_t newalloc, + const char *filename, const int linenumber, + const char *funcname) { # if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD) const char *s; # endif - PERL_ARGS_ASSERT_MEM_LOG_COMMON; + /* PERL_ARGS_ASSERT_MEM_LOG_COMMON; */ # ifdef PERL_MEM_LOG_ENV s = PerlEnv_getenv(mlt < MLT_NEW_SV ? "PERL_MEM_LOG" : "PERL_SV_LOG"); @@ -5593,54 +5599,78 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const cha filename, linenumber, funcname, PTR2UV(sv) _SV_LOG_SERIAL_ARG(sv)); break; + default: + len = 0; } PerlLIO_write(fd, buf, len); } } } +#endif /* !PERL_MEM_LOG_NOIMPL */ + +#ifndef PERL_MEM_LOG_NOIMPL +# define \ + mem_log_common_if(alty, num, tysz, tynm, sv, oal, nal, flnm, ln, fnnm) \ + mem_log_common (alty, num, tysz, tynm, sv, oal, nal, flnm, ln, fnnm) +#else +/* this is suboptimal, but bug compatible. User is providing their + own implemenation, but is getting these functions anyway, and they + do nothing. But _NOIMPL users should be able to cope or fix */ +# define \ + mem_log_common_if(alty, num, tysz, tynm, u, oal, nal, flnm, ln, fnnm) \ + /* mem_log_common_if_PERL_MEM_LOG_NOIMPL */ #endif Malloc_t -Perl_mem_log_alloc(const UV n, const UV typesize, const char *type_name, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname) -{ -#ifdef PERL_MEM_LOG_STDERR - mem_log_common(MLT_ALLOC, n, typesize, type_name, NULL, NULL, newalloc, filename, linenumber, funcname); -#endif +Perl_mem_log_alloc(const UV n, const UV typesize, const char *type_name, + Malloc_t newalloc, + const char *filename, const int linenumber, + const char *funcname) +{ + mem_log_common_if(MLT_ALLOC, n, typesize, type_name, + NULL, NULL, newalloc, + filename, linenumber, funcname); return newalloc; } Malloc_t -Perl_mem_log_realloc(const UV n, const UV typesize, const char *type_name, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname) -{ -#ifdef PERL_MEM_LOG_STDERR - mem_log_common(MLT_REALLOC, n, typesize, type_name, NULL, oldalloc, newalloc, filename, linenumber, funcname); -#endif +Perl_mem_log_realloc(const UV n, const UV typesize, const char *type_name, + Malloc_t oldalloc, Malloc_t newalloc, + const char *filename, const int linenumber, + const char *funcname) +{ + mem_log_common_if(MLT_REALLOC, n, typesize, type_name, + NULL, oldalloc, newalloc, + filename, linenumber, funcname); return newalloc; } Malloc_t -Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname) +Perl_mem_log_free(Malloc_t oldalloc, + const char *filename, const int linenumber, + const char *funcname) { -#ifdef PERL_MEM_LOG_STDERR - mem_log_common(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, filename, linenumber, funcname); -#endif + mem_log_common_if(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, + filename, linenumber, funcname); return oldalloc; } void -Perl_mem_log_new_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname) +Perl_mem_log_new_sv(const SV *sv, + const char *filename, const int linenumber, + const char *funcname) { -#ifdef PERL_MEM_LOG_STDERR - mem_log_common(MLT_NEW_SV, 0, 0, "", sv, NULL, NULL, filename, linenumber, funcname); -#endif + mem_log_common_if(MLT_NEW_SV, 0, 0, "", sv, NULL, NULL, + filename, linenumber, funcname); } void -Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname) +Perl_mem_log_del_sv(const SV *sv, + const char *filename, const int linenumber, + const char *funcname) { -#ifdef PERL_MEM_LOG_STDERR - mem_log_common(MLT_DEL_SV, 0, 0, "", sv, NULL, NULL, filename, linenumber, funcname); -#endif + mem_log_common_if(MLT_DEL_SV, 0, 0, "", sv, NULL, NULL, + filename, linenumber, funcname); } #endif /* PERL_MEM_LOG */ -- 2.7.4