diff options
| -rw-r--r-- | embed.fnc | 7 | ||||
| -rw-r--r-- | handy.h | 14 | ||||
| -rw-r--r-- | util.c | 163 |
3 files changed, 85 insertions, 99 deletions
@@ -1678,6 +1678,13 @@ 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) +sn |void |mem_log_common |enum mem_log_type mlt|const UV n|const UV typesize \ + |NN const char *typename \ + |Malloc_t oldalloc|Malloc_t newalloc \ + |NN const char *filename|const int linenumber \ + |NN const char *funcname +#endif #endif #if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT) @@ -768,11 +768,21 @@ Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const char *typenam 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 +enum mem_log_type { + MLT_ALLOC, + MLT_REALLOC, + MLT_FREE +}; +# endif +# endif + #endif #ifdef PERL_MEM_LOG -#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_ALLOC(n,t,a) (t*)Perl_mem_log_alloc(n,sizeof(t),STRINGIFY(t),a,__FILE__,__LINE__,FUNCTION__) +#define MEM_LOG_REALLOC(n,t,v,a) (t*)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 @@ -5522,6 +5522,11 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp) * variable PERL_MEM_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.) + * + * PERL_MEM_LOG_TIMESTAMP: if defined, 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. */ /* @@ -5540,15 +5545,15 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp) # define PERL_MEM_LOG_FD 2 /* If STDERR is too boring for you. */ #endif -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) -{ #ifdef PERL_MEM_LOG_STDERR +static void +S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const char *typename, 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) - char *s; + const char *s; # endif # ifdef PERL_MEM_LOG_ENV - s = getenv("PERL_MEM_LOG"); + s = PerlEnv_getenv("PERL_MEM_LOG"); if (s ? atoi(s) : 0) # endif { @@ -5556,9 +5561,16 @@ Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t * so we'll use stdio and low-level IO instead. */ char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE]; # ifdef PERL_MEM_LOG_TIMESTAMP - struct timeval tv; # ifdef HAS_GETTIMEOFDAY +# define MEM_LOG_TIME_FMT "%10d.%06d: " +# define MEM_LOG_TIME_ARG (int)tv.tv_sec, (int)tv.tv_usec + struct timeval tv; gettimeofday(&tv, 0); +# else +# define MEM_LOG_TIME_FMT "%10d: " +# define MEM_LOG_TIME_ARG (int)when + Time_t when; + (void)time(&when); # endif /* If there are other OS specific ways of hires time than * gettimeofday() (see ext/Time/HiRes), the easiest way is @@ -5566,27 +5578,56 @@ Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t * timeval. */ # endif { - const STRLEN len = - my_snprintf(buf, - sizeof(buf), -# ifdef PERL_MEM_LOG_TIMESTAMP - "%10d.%06d: " + int fd = PERL_MEM_LOG_FD; + STRLEN len; + +# ifdef PERL_MEM_LOG_ENV_FD + if ((s = PerlEnv_getenv("PERL_MEM_LOG_FD"))) { + fd = atoi(s); + } # endif - "alloc: %s:%d:%s: %"IVdf" %"UVuf - " %s = %"IVdf": %"UVxf"\n", -# ifdef PERL_MEM_LOG_TIMESTAMP - (int)tv.tv_sec, (int)tv.tv_usec, +# ifdef PERL_MEM_LOG_TIMESTAMP + s = PerlEnv_getenv("PERL_MEM_LOG_TIMESTAMP"); + if (!s || atoi(s)) { + len = my_snprintf(buf, sizeof(buf), + MEM_LOG_TIME_FMT, MEM_LOG_TIME_ARG); + PerlLIO_write(fd, buf, len); + } # endif - filename, linenumber, funcname, n, typesize, - typename, n * typesize, PTR2UV(newalloc)); -# ifdef PERL_MEM_LOG_ENV_FD - s = PerlEnv_getenv("PERL_MEM_LOG_FD"); - PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len); -# else - PerlLIO_write(PERL_MEM_LOG_FD, buf, len); -#endif + switch (mlt) { + case MLT_ALLOC: + len = my_snprintf(buf, sizeof(buf), + "alloc: %s:%d:%s: %"IVdf" %"UVuf + " %s = %"IVdf": %"UVxf"\n", + filename, linenumber, funcname, n, typesize, + typename, n * typesize, PTR2UV(newalloc)); + break; + case MLT_REALLOC: + len = my_snprintf(buf, sizeof(buf), + "realloc: %s:%d:%s: %"IVdf" %"UVuf + " %s = %"IVdf": %"UVxf" -> %"UVxf"\n", + filename, linenumber, funcname, n, typesize, + typename, n * typesize, PTR2UV(oldalloc), + PTR2UV(newalloc)); + break; + case MLT_FREE: + len = my_snprintf(buf, sizeof(buf), + "free: %s:%d:%s: %"UVxf"\n", + filename, linenumber, funcname, + PTR2UV(oldalloc)); + break; + } + PerlLIO_write(fd, buf, len); } } +} +#endif + +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) +{ +#ifdef PERL_MEM_LOG_STDERR + mem_log_common(MLT_ALLOC, n, typesize, typename, NULL, newalloc, filename, linenumber, funcname); #endif return newalloc; } @@ -5595,44 +5636,7 @@ 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) { #ifdef PERL_MEM_LOG_STDERR -# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD) - char *s; -# endif -# ifdef PERL_MEM_LOG_ENV - s = PerlEnv_getenv("PERL_MEM_LOG"); - if (s ? atoi(s) : 0) -# endif - { - /* We can't use SVs or PerlIO for obvious reasons, - * so we'll use stdio and low-level IO instead. */ - char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE]; -# ifdef PERL_MEM_LOG_TIMESTAMP - struct timeval tv; - gettimeofday(&tv, 0); -# endif - { - const STRLEN len = - my_snprintf(buf, - sizeof(buf), -# ifdef PERL_MEM_LOG_TIMESTAMP - "%10d.%06d: " -# endif - "realloc: %s:%d:%s: %"IVdf" %"UVuf - " %s = %"IVdf": %"UVxf" -> %"UVxf"\n", -# ifdef PERL_MEM_LOG_TIMESTAMP - (int)tv.tv_sec, (int)tv.tv_usec, -# endif - filename, linenumber, funcname, n, typesize, - typename, n * typesize, PTR2UV(oldalloc), - PTR2UV(newalloc)); -# ifdef PERL_MEM_LOG_ENV_FD - s = PerlEnv_getenv("PERL_MEM_LOG_FD"); - PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len); -# else - PerlLIO_write(PERL_MEM_LOG_FD, buf, len); -# endif - } - } + mem_log_common(MLT_REALLOC, n, typesize, typename, oldalloc, newalloc, filename, linenumber, funcname); #endif return newalloc; } @@ -5641,42 +5645,7 @@ Malloc_t Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname) { #ifdef PERL_MEM_LOG_STDERR -# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD) - char *s; -# endif -# ifdef PERL_MEM_LOG_ENV - s = PerlEnv_getenv("PERL_MEM_LOG"); - if (s ? atoi(s) : 0) -# endif - { - /* We can't use SVs or PerlIO for obvious reasons, - * so we'll use stdio and low-level IO instead. */ - char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE]; -# ifdef PERL_MEM_LOG_TIMESTAMP - struct timeval tv; - gettimeofday(&tv, 0); -# endif - { - const STRLEN len = - my_snprintf(buf, - sizeof(buf), -# ifdef PERL_MEM_LOG_TIMESTAMP - "%10d.%06d: " -# endif - "free: %s:%d:%s: %"UVxf"\n", -# ifdef PERL_MEM_LOG_TIMESTAMP - (int)tv.tv_sec, (int)tv.tv_usec, -# endif - filename, linenumber, funcname, - PTR2UV(oldalloc)); -# ifdef PERL_MEM_LOG_ENV_FD - s = PerlEnv_getenv("PERL_MEM_LOG_FD"); - PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len); -# else - PerlLIO_write(PERL_MEM_LOG_FD, buf, len); -# endif - } - } + mem_log_common(MLT_FREE, 0, 0, "", oldalloc, NULL, filename, linenumber, funcname); #endif return oldalloc; } |