[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
[PATCH] Add SV allocation tracing to -Dm and PERL_MEM_LOG
There are quite often memory (SV) leaks that are hard to find despite
valgrind and DEBUG_LEAKING_SCALARS. To find the source of the two
recent regexp-related leaks (perl #59516), I hacked in some code
that evolved into the attached patch.
When building with DEBUG_LEAKING_SCALARS, it adds yet another field
to the SV struct. This field stores a serial number for each SV
allocation. The serial number for each interpreter is kept in a new
variable PL_sv_serial and is incremented with each call to new_SV().
Also, the patch adds SV allocation and deallocation tracing to -Dm
and PERL_MEM_LOG (using a new environment variable PERL_SV_LOG). The
serial number will be printed along with each new_SV and del_SV trace.
Now, if you run the potentially leaking code in a loop, it's very
easy to see from the serial numbers which SV's are leaking. And once
the serial number of the leaked SV is known, it's easy to set a
conditional breakpoint within new_SV() that breaks when the SV with
that serial number is allocated. At this point, you have a full call
stack, and that should usually be enough to spot the source of the leak.
The patch adds some documentation on how to use all this to perlhack.
This patch won't apply without the Perl_mem_log_ refactoring patch.
It also requires a "make regen".
I'll eventually apply both patches if I don't get any negative feedback.
Marcus
--
Goldenstern's Rules:
(1) Always hire a rich attorney
(2) Never buy from a rich salesman.
diff -ruN perl-current-1-mem-log/embed.fnc perl-current-2-sv-alloc/embed.fnc
--- perl-current-1-mem-log/embed.fnc 2008-10-21 23:51:03.000000000 +0200
+++ perl-current-2-sv-alloc/embed.fnc 2008-10-21 23:56:08.000000000 +0200
@@ -1680,7 +1680,7 @@
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 \
+ |NN const char *typename|NULLOK const SV *sv \
|Malloc_t oldalloc|Malloc_t newalloc \
|NN const char *filename|const int linenumber \
|NN const char *funcname
diff -ruN perl-current-1-mem-log/handy.h perl-current-2-sv-alloc/handy.h
--- perl-current-1-mem-log/handy.h 2008-10-21 23:53:13.000000000 +0200
+++ perl-current-2-sv-alloc/handy.h 2008-10-21 23:56:08.000000000 +0200
@@ -773,9 +773,14 @@
enum mem_log_type {
MLT_ALLOC,
MLT_REALLOC,
- MLT_FREE
+ MLT_FREE,
+ MLT_NEW_SV,
+ MLT_DEL_SV
};
# endif
+/* those are only used in sv.c */
+void Perl_mem_log_new_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname);
+void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumber, const char *funcname);
# endif
#endif
diff -ruN perl-current-1-mem-log/intrpvar.h perl-current-2-sv-alloc/intrpvar.h
--- perl-current-1-mem-log/intrpvar.h 2008-10-21 23:43:12.000000000 +0200
+++ perl-current-2-sv-alloc/intrpvar.h 2008-10-21 23:56:08.000000000 +0200
@@ -674,6 +674,10 @@
/* Can shared object be destroyed */
PERLVARI(Idestroyhook, destroyable_proc_t, MEMBER_TO_FPTR(Perl_sv_destroyable))
+#ifdef DEBUG_LEAKING_SCALARS
+PERLVARI(Isv_serial, U32, 0) /* SV serial number, used in sv.c */
+#endif
+
/* If you are adding a U8 or U16, check to see if there are 'Space' comments
* above on where there are gaps which currently will be structure padding. */
diff -ruN perl-current-1-mem-log/perl.c perl-current-2-sv-alloc/perl.c
--- perl-current-1-mem-log/perl.c 2008-10-21 23:43:11.000000000 +0200
+++ perl-current-2-sv-alloc/perl.c 2008-10-21 23:56:08.000000000 +0200
@@ -2961,7 +2961,7 @@
" o Method and overloading resolution",
" c String/numeric conversions",
" P Print profiling info, source file input state",
- " m Memory allocation",
+ " m Memory and SV allocation",
" f Format processing",
" r Regular expression parsing and execution",
" x Syntax tree dump",
diff -ruN perl-current-1-mem-log/pod/perlhack.pod perl-current-2-sv-alloc/pod/perlhack.pod
--- perl-current-1-mem-log/pod/perlhack.pod 2008-10-21 23:43:11.000000000 +0200
+++ perl-current-2-sv-alloc/pod/perlhack.pod 2008-10-21 23:56:08.000000000 +0200
@@ -3196,6 +3196,27 @@
converts C<new_SV()> from a macro into a real function, so you can use
your favourite debugger to discover where those pesky SVs were allocated.
+If you see that you're leaking memory at runtime, but neither valgrind
+nor C<-DDEBUG_LEAKING_SCALARS> will find anything, you're probably
+leaking SVs that are still reachable and will be properly cleaned up
+during destruction of the interpreter. In such cases, using the C<-Dm>
+switch can point you to the source of the leak. If the executable was
+built with C<-DDEBUG_LEAKING_SCALARS>, C<-Dm> will output SV allocations
+in addition to memory allocations. Each SV allocation has a distinct
+serial number that will be written on creation and destruction of the SV.
+So if you're executing the leaking code in a loop, you need to look for
+SVs that are created, but never destroyed between each cycle. If such an
+SV is found, set a conditional breakpoint within C<new_SV()> and make it
+break only when C<PL_sv_serial> is equal to the serial number of the
+leaking SV. Then you will catch the interpreter in exactly the state
+where the leaking SV is allocated, which is sufficient in many cases to
+find the source of the leak.
+
+As C<-Dm> is using the PerlIO layer for output, it will by itself
+allocate quite a bunch of SVs, which are hidden to avoid recursion.
+You can bypass the PerlIO layer if you use the SV logging provided
+by C<-DPERL_MEM_LOG> instead.
+
=head2 PERL_MEM_LOG
If compiled with C<-DPERL_MEM_LOG>, all Newx() and Renew() allocations
@@ -3209,6 +3230,17 @@
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.
+
=head2 Profiling
Depending on your platform there are various of profiling Perl.
diff -ruN perl-current-1-mem-log/pod/perlrun.pod perl-current-2-sv-alloc/pod/perlrun.pod
--- perl-current-1-mem-log/pod/perlrun.pod 2008-10-21 23:43:11.000000000 +0200
+++ perl-current-2-sv-alloc/pod/perlrun.pod 2008-10-21 23:56:08.000000000 +0200
@@ -395,7 +395,7 @@
16 o Method and overloading resolution
32 c String/numeric conversions
64 P Print profiling info, source file input state
- 128 m Memory allocation
+ 128 m Memory and SV allocation
256 f Format processing
512 r Regular expression parsing and execution
1024 x Syntax tree dump
diff -ruN perl-current-1-mem-log/sv.c perl-current-2-sv-alloc/sv.c
--- perl-current-1-mem-log/sv.c 2008-10-21 23:43:11.000000000 +0200
+++ perl-current-2-sv-alloc/sv.c 2008-10-21 23:56:08.000000000 +0200
@@ -173,10 +173,24 @@
}
}
+#ifdef PERL_MEM_LOG
+# define MEM_LOG_NEW_SV(sv, file, line, func) \
+ Perl_mem_log_new_sv(sv, file, line, func)
+# define MEM_LOG_DEL_SV(sv, file, line, func) \
+ Perl_mem_log_del_sv(sv, file, line, func)
+#else
+# define MEM_LOG_NEW_SV(sv, file, line, func) NOOP
+# define MEM_LOG_DEL_SV(sv, file, line, func) NOOP
+#endif
+
#ifdef DEBUG_LEAKING_SCALARS
# define FREE_SV_DEBUG_FILE(sv) Safefree((sv)->sv_debug_file)
+# define DEBUG_SV_SERIAL(sv) \
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) del_SV\n", \
+ PTR2UV(sv), (long)(sv)->sv_debug_serial))
#else
# define FREE_SV_DEBUG_FILE(sv)
+# define DEBUG_SV_SERIAL(sv) NOOP
#endif
#ifdef PERL_POISON
@@ -202,6 +216,8 @@
#define plant_SV(p) \
STMT_START { \
const U32 old_flags = SvFLAGS(p); \
+ MEM_LOG_DEL_SV(p, __FILE__, __LINE__, FUNCTION__); \
+ DEBUG_SV_SERIAL(p); \
FREE_SV_DEBUG_FILE(p); \
POSION_SV_HEAD(p); \
SvFLAGS(p) = SVTYPEMASK; \
@@ -247,7 +263,7 @@
#ifdef DEBUG_LEAKING_SCALARS
/* provide a real function for a debugger to play with */
STATIC SV*
-S_new_SV(pTHX)
+S_new_SV(pTHX_ const char *file, int line, const char *func)
{
SV* sv;
@@ -268,10 +284,16 @@
sv->sv_debug_inpad = 0;
sv->sv_debug_cloned = 0;
sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
-
+
+ sv->sv_debug_serial = PL_sv_serial++;
+
+ MEM_LOG_NEW_SV(sv, file, line, func);
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) new_SV (from %s:%d [%s])\n",
+ PTR2UV(sv), (long)sv->sv_debug_serial, file, line, func));
+
return sv;
}
-# define new_SV(p) (p)=S_new_SV(aTHX)
+# define new_SV(p) (p)=S_new_SV(aTHX_ __FILE__, __LINE__, FUNCTION__)
#else
# define new_SV(p) \
@@ -283,6 +305,7 @@
SvANY(p) = 0; \
SvREFCNT(p) = 1; \
SvFLAGS(p) = 0; \
+ MEM_LOG_NEW_SV(p, __FILE__, __LINE__, FUNCTION__); \
} STMT_END
#endif
diff -ruN perl-current-1-mem-log/sv.h perl-current-2-sv-alloc/sv.h
--- perl-current-1-mem-log/sv.h 2008-10-21 23:43:11.000000000 +0200
+++ perl-current-2-sv-alloc/sv.h 2008-10-21 23:56:08.000000000 +0200
@@ -121,6 +121,7 @@
PERL_BITFIELD32 sv_debug_inpad:1; /* was allocated in a pad for an OP */
PERL_BITFIELD32 sv_debug_cloned:1; /* was cloned for an ithread */
PERL_BITFIELD32 sv_debug_line:16; /* the line where we were allocated */
+ U32 sv_debug_serial; /* serial number of sv allocation */
char * sv_debug_file; /* the file where we were allocated */
#endif
};
diff -ruN perl-current-1-mem-log/util.c perl-current-2-sv-alloc/util.c
--- perl-current-1-mem-log/util.c 2008-10-22 00:04:50.000000000 +0200
+++ perl-current-2-sv-alloc/util.c 2008-10-22 00:05:41.000000000 +0200
@@ -5519,9 +5519,10 @@
* PERL_MEM_LOG: the Perl_mem_log_..() will be compiled.
*
* PERL_MEM_LOG_ENV: if defined, during run time the environment
- * 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.)
+ * 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.)
*
* PERL_MEM_LOG_TIMESTAMP: if defined, a timestamp will be logged
* before every memory logging entry. This can be turned off at run
@@ -5546,14 +5547,23 @@
#endif
#ifdef PERL_MEM_LOG_STDERR
+
+# ifdef DEBUG_LEAKING_SCALARS
+# define SV_LOG_SERIAL_FMT " [%lu]"
+# define _SV_LOG_SERIAL_ARG(sv) , (unsigned long) (sv)->sv_debug_serial
+# else
+# define SV_LOG_SERIAL_FMT
+# define _SV_LOG_SERIAL_ARG(sv)
+# endif
+
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)
+S_mem_log_common(enum mem_log_type mlt, const UV n, const UV typesize, const char *typename, 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
# ifdef PERL_MEM_LOG_ENV
- s = PerlEnv_getenv("PERL_MEM_LOG");
+ s = PerlEnv_getenv(mlt < MLT_NEW_SV ? "PERL_MEM_LOG" : "PERL_SV_LOG");
if (s ? atoi(s) : 0)
# endif
{
@@ -5616,6 +5626,14 @@
filename, linenumber, funcname,
PTR2UV(oldalloc));
break;
+ case MLT_NEW_SV:
+ case MLT_DEL_SV:
+ len = my_snprintf(buf, sizeof(buf),
+ "%s_SV: %s:%d:%s: %"UVxf SV_LOG_SERIAL_FMT "\n",
+ mlt == MLT_NEW_SV ? "new" : "del",
+ filename, linenumber, funcname,
+ PTR2UV(sv) _SV_LOG_SERIAL_ARG(sv));
+ break;
}
PerlLIO_write(fd, buf, len);
}
@@ -5627,7 +5645,7 @@
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);
+ mem_log_common(MLT_ALLOC, n, typesize, typename, NULL, NULL, newalloc, filename, linenumber, funcname);
#endif
return newalloc;
}
@@ -5636,7 +5654,7 @@
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
- mem_log_common(MLT_REALLOC, n, typesize, typename, oldalloc, newalloc, filename, linenumber, funcname);
+ mem_log_common(MLT_REALLOC, n, typesize, typename, NULL, oldalloc, newalloc, filename, linenumber, funcname);
#endif
return newalloc;
}
@@ -5645,11 +5663,27 @@
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, "", oldalloc, NULL, filename, linenumber, funcname);
+ mem_log_common(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, filename, linenumber, funcname);
#endif
return oldalloc;
}
+void
+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
+}
+
+void
+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
+}
+
#endif /* PERL_MEM_LOG */
/*
signature.asc
- Follow-Ups from:
-
Marcus Holland-Moritz <mhx-perl@gmx.net>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]