In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2e5b50041f3643ca27385b211da60add40857ec8?hp=4fec321675757b1adbfc9b8317737404d211664f>
- Log ----------------------------------------------------------------- commit 2e5b50041f3643ca27385b211da60add40857ec8 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 21 14:27:43 2009 +0200 A few docs nits after the few last commits M pod/perlhack.pod M util.c commit 4bd8fafa9f9185d83cee6991ca49c6ac9b8782a4 Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 21 14:16:55 2009 +0200 Also replace PERL_MEM_LOG_STDERR by PERL_MEM_LOG_NOIMPL in the -V output M perl.c commit fd5aa6c359a400a4ad1156429c8cc40e21a5bcad Author: Rafael Garcia-Suarez <[email protected]> Date: Sun Jun 21 14:15:34 2009 +0200 Regenerate headers M embed.h M proto.h commit 10a879f5b15504fdd9aa98740d738732eeee2f22 Author: Jim Cromie <[email protected]> Date: Sat Jun 20 09:43:43 2009 -0600 update PERL_MEM_LOG in perlhack.pod M pod/perlhack.pod commit 1cd8acb500c6fd96bf025feb0647211c271b7e2e Author: Jim Cromie <[email protected]> Date: Wed Jun 17 02:12:45 2009 -0600 simplify PERL_MEM_LOG This combines multiple environment variable reads into 1, where it looks for values like "2mst" -2 leading digits are atoi()d to get FD -m memory logging please -s sv logging also -t timestamp those please. Combining these reduces overhead such that it seemed worthwhile to drop all the ifdefs. TBD whether this works in the environment that drove the original tradeoffs. If it isnt enough, Id be tempted by a global static ptr, and on 1st use, is read, seen 0, a lock is taken, and getenvar run to populate it, unlocked, proceed. This would remove iterative overheads. M util.c commit 73d1d97336c68e0f5b29937cb9347a00df4c645c Author: Jim Cromie <[email protected]> Date: Thu Jun 11 16:28:46 2009 -0600 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. M embed.fnc M handy.h M util.c commit de10be12cd3b4d2e91c136c495230f49b31a4511 Author: Jim Cromie <[email protected]> Date: Fri Jun 12 15:27:11 2009 -0600 point illguts at perl.org M pod/perlhack.pod ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- embed.h | 4 +- handy.h | 6 ++- perl.c | 4 +- pod/perlhack.pod | 54 +++++++++++---------- proto.h | 2 +- util.c | 138 ++++++++++++++++++++++++++++++------------------------ 7 files changed, 116 insertions(+), 94 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/embed.h b/embed.h index 1b2c9de..6f6877f 100644 --- a/embed.h +++ b/embed.h @@ -1622,7 +1622,7 @@ #define vdie_common S_vdie_common #define write_no_mem S_write_no_mem #endif -#if defined(PERL_MEM_LOG) && defined(PERL_MEM_LOG_STDERR) +#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL) #ifdef PERL_CORE #define mem_log_common S_mem_log_common #endif @@ -3970,7 +3970,7 @@ #define vdie_common(a,b,c,d) S_vdie_common(aTHX_ a,b,c,d) #define write_no_mem() S_write_no_mem(aTHX) #endif -#if defined(PERL_MEM_LOG) && defined(PERL_MEM_LOG_STDERR) +#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL) #ifdef PERL_CORE #define mem_log_common S_mem_log_common #endif 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/perl.c b/perl.c index 8b4f8d7..4712a8b 100644 --- a/perl.c +++ b/perl.c @@ -1778,8 +1778,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) # ifdef PERL_MEM_LOG_ENV_FD " PERL_MEM_LOG_ENV_FD" # endif -# ifdef PERL_MEM_LOG_STDERR - " PERL_MEM_LOG_STDERR" +# ifdef PERL_MEM_LOG_NOIMPL + " PERL_MEM_LOG_NOIMPL" # endif # ifdef PERL_MEM_LOG_TIMESTAMP " PERL_MEM_LOG_TIMESTAMP" diff --git a/pod/perlhack.pod b/pod/perlhack.pod index 72c2fc0..b4cfc4f 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -321,10 +321,12 @@ might start to make sense - don't worry if it doesn't yet, because the best way to study it is to read it in conjunction with poking at Perl source, and we'll do that later on. -You might also want to look at Gisle Aas's illustrated perlguts - -there's no guarantee that this will be absolutely up-to-date with the -latest documentation in the Perl core, but the fundamentals will be -right. ( http://gisle.aas.no/perl/illguts/ ) +Gisle Aas's illustrated perlguts (also known as I<illguts>) is wonderful, +although a little out of date with regard to some size details; the +various SV structures have since been reworked for smaller memory footprint. +The fundamentals are right however, and the pictures are very helpful. + +L<http://www.perl.org/tpc/1998/Perl_Language_and_Modules/Perl%20Illustrated/> =item L<perlxstut> and L<perlxs> @@ -2940,27 +2942,29 @@ by C<-DPERL_MEM_LOG> instead. =head2 PERL_MEM_LOG -If compiled with C<-DPERL_MEM_LOG>, all Newx() 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 (or more precisely, to the -file descriptor 2) in these logging functions, with the calling source code -file and line number (and C function name, if supported by the C compiler). - -This logging is somewhat similar to C<-Dm> but independent of C<-DDEBUGGING>, -and at a higher level (the C<-Dm> is directly at the point of C<malloc()>, -while the C<PERL_MEM_LOG> is at the level of C<New()>). - -In addition to memory allocations, SV allocations will be logged, just as -with C<-Dm>. However, since the logging doesn't use PerlIO, all SV allocations -are logged and no extra SV allocations are introduced by enabling the logging. -If compiled with C<-DDEBUG_LEAKING_SCALARS>, the serial number for each SV -allocation is also logged. - -You can control the logging from your environment if you compile with -C<-DPERL_MEM_LOG_ENV>. Then you need to explicitly set C<PERL_MEM_LOG> and/or -C<PERL_SV_LOG> to a non-zero value to enable logging of memory and/or SV -allocations. +If compiled with C<-DPERL_MEM_LOG>, both memory and SV allocations go +through logging functions, which is handy for breakpoint setting. + +Unless C<-DPERL_MEM_LOG_NOIMPL> is also compiled, the logging +functions read $ENV{PERL_MEM_LOG} to determine whether to log the +event, and if so how: + + $ENV{PERL_MEM_LOG} =~ /m/ Log all memory ops + $ENV{PERL_MEM_LOG} =~ /s/ Log all SV ops + $ENV{PERL_MEM_LOG} =~ /t/ include timestamp in Log + $ENV{PERL_MEM_LOG} =~ /^(\d+)/ write to FD given (default is 2) + +Memory logging is somewhat similar to C<-Dm> but is independent of +C<-DDEBUGGING>, and at a higher level; all uses of Newx(), Renew(), +and Safefree() are logged with the caller's source code file and line +number (and C function name, if supported by the C compiler). In +contrast, C<-Dm> is directly at the point of C<malloc()>. SV logging +is similar. + +Since the logging doesn't use PerlIO, all SV allocations are logged +and no extra SV allocations are introduced by enabling the logging. +If compiled with C<-DDEBUG_LEAKING_SCALARS>, the serial number for +each SV allocation is also logged. =head2 Profiling diff --git a/proto.h b/proto.h index ffa7c39..fc06fb1 100644 --- a/proto.h +++ b/proto.h @@ -5889,7 +5889,7 @@ STATIC bool S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8, bo STATIC char * S_write_no_mem(pTHX) __attribute__noreturn__; -#if defined(PERL_MEM_LOG) && defined(PERL_MEM_LOG_STDERR) +#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL) 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 linenumbe ... [24 chars truncated] __attribute__nonnull__(4) __attribute__nonnull__(8) diff --git a/util.c b/util.c index 469a9da..d8d2864 100644 --- a/util.c +++ b/util.c @@ -5471,38 +5471,35 @@ 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. + * + * The default implementation reads a single env var, PERL_MEM_LOG, + * expecting one or more of the following: * - * 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.) + * \d+ - fd fd to write to : must be 1st (atoi) + * 'm' - memlog was PERL_MEM_LOG=1 + * 's' - svlog was PERL_SV_LOG=1 + * 't' - timestamp was PERL_MEM_LOG_TIMESTAMP=1 * - * 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. + * This makes the logger controllable enough that it can reasonably be + * added to the system perl. */ -/* - * 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=N: the file descriptor the Perl_mem_log_...() + * writes to. In the default logger, this is settable at runtime. */ #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,23 +5510,25 @@ 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 cha ... [12 chars truncated] +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 + const char *pmlenv; PERL_ARGS_ASSERT_MEM_LOG_COMMON; -# ifdef PERL_MEM_LOG_ENV - s = PerlEnv_getenv(mlt < MLT_NEW_SV ? "PERL_MEM_LOG" : "PERL_SV_LOG"); - if (s ? atoi(s) : 0) -# endif + pmlenv = PerlEnv_getenv("PERL_MEM_LOG"); + if (!pmlenv) + return; + if (mlt < MLT_NEW_SV ? strchr(pmlenv,'m') : strchr(pmlenv,'s')) { /* 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 + # ifdef HAS_GETTIMEOFDAY # define MEM_LOG_TIME_FMT "%10d.%06d: " # define MEM_LOG_TIME_ARG (int)tv.tv_sec, (int)tv.tv_usec @@ -5545,24 +5544,17 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const cha * gettimeofday() (see ext/Time-HiRes), the easiest way is * probably that they would be used to fill in the struct * timeval. */ -# endif { - int fd = PERL_MEM_LOG_FD; STRLEN len; + int fd = atoi(pmlenv); + if (!fd) + fd = PERL_MEM_LOG_FD; -# ifdef PERL_MEM_LOG_ENV_FD - if ((s = PerlEnv_getenv("PERL_MEM_LOG_FD"))) { - fd = atoi(s); - } -# endif -# ifdef PERL_MEM_LOG_TIMESTAMP - s = PerlEnv_getenv("PERL_MEM_LOG_TIMESTAMP"); - if (!s || atoi(s)) { + if (strchr(pmlenv, 't')) { len = my_snprintf(buf, sizeof(buf), MEM_LOG_TIME_FMT, MEM_LOG_TIME_ARG); PerlLIO_write(fd, buf, len); } -# endif switch (mlt) { case MLT_ALLOC: len = my_snprintf(buf, sizeof(buf), @@ -5593,54 +5585,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 */ -- Perl5 Master Repository
