Change 34568 by [EMAIL PROTECTED] on 2008/10/24 16:35:48
Subject: [PATCH] Add SV allocation tracing to -Dm and PERL_MEM_LOG
From: Marcus Holland-Moritz <[EMAIL PROTECTED]>
Date: Wed, 22 Oct 2008 01:37:31 +0200
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#621 edit
... //depot/perl/handy.h#145 edit
... //depot/perl/intrpvar.h#235 edit
... //depot/perl/perl.c#876 edit
... //depot/perl/pod/perlhack.pod#139 edit
... //depot/perl/pod/perlrun.pod#169 edit
... //depot/perl/sv.c#1557 edit
... //depot/perl/sv.h#351 edit
... //depot/perl/util.c#657 edit
Differences ...
==== //depot/perl/embed.fnc#621 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#620~34567~ 2008-10-24 09:32:50.000000000 -0700
+++ perl/embed.fnc 2008-10-24 09:35:48.000000000 -0700
@@ -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
==== //depot/perl/handy.h#145 (text) ====
Index: perl/handy.h
--- perl/handy.h#144~34567~ 2008-10-24 09:32:50.000000000 -0700
+++ perl/handy.h 2008-10-24 09:35:48.000000000 -0700
@@ -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
==== //depot/perl/intrpvar.h#235 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#234~33355~ 2008-02-22 14:30:05.000000000 -0800
+++ perl/intrpvar.h 2008-10-24 09:35:48.000000000 -0700
@@ -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. */
==== //depot/perl/perl.c#876 (text) ====
Index: perl/perl.c
--- perl/perl.c#875~34463~ 2008-10-05 10:39:24.000000000 -0700
+++ perl/perl.c 2008-10-24 09:35:48.000000000 -0700
@@ -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",
==== //depot/perl/pod/perlhack.pod#139 (text) ====
Index: perl/pod/perlhack.pod
--- perl/pod/perlhack.pod#138~33570~ 2008-03-26 04:17:38.000000000 -0700
+++ perl/pod/perlhack.pod 2008-10-24 09:35:48.000000000 -0700
@@ -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.
==== //depot/perl/pod/perlrun.pod#169 (text) ====
Index: perl/pod/perlrun.pod
--- perl/pod/perlrun.pod#168~34081~ 2008-06-23 22:24:39.000000000 -0700
+++ perl/pod/perlrun.pod 2008-10-24 09:35:48.000000000 -0700
@@ -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
==== //depot/perl/sv.c#1557 (text) ====
Index: perl/sv.c
--- perl/sv.c#1556~34479~ 2008-10-14 14:16:05.000000000 -0700
+++ perl/sv.c 2008-10-24 09:35:48.000000000 -0700
@@ -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
==== //depot/perl/sv.h#351 (text) ====
Index: perl/sv.h
--- perl/sv.h#350~34134~ 2008-07-12 01:44:21.000000000 -0700
+++ perl/sv.h 2008-10-24 09:35:48.000000000 -0700
@@ -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
};
==== //depot/perl/util.c#657 (text) ====
Index: perl/util.c
--- perl/util.c#656~34567~ 2008-10-24 09:32:50.000000000 -0700
+++ perl/util.c 2008-10-24 09:35:48.000000000 -0700
@@ -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 */
/*
End of Patch.
