On Wed, Feb 23, 2005 at 11:40:09PM -0500, Stas Bekman wrote:
> The scalars leaking reporting needs to be improved. At the moment if you
> get a scalars leaked reported and it didn't happen when you've added that
> new line of XS/C code you really have no idea where does it coming from.
> With -DDEBUG_LEAKING_SCALARS the best you can get is:
>
> Scalars leaked: 1
> leaked: sv=0x9d155d4 flags=0x0880003 refcnt=0, Perl interpreter: 0x89bdd40
The change I've committed below expands the behaviour of
-DDEBUG_LEAKING_SCALARS
to record where each SV is created. It conditionally adds a few extra
fields to the SV struct, which record the filename, lineno and responsible
op type. This info is displayed in the output of Devel::Peek as well as in
the leaked message above, eg
$ ./perl -Ilib -MDevel::Peek -e 'Dump $a+1'
ALLOCATED at -e:1 for add
SV = NV(0x8dbc590) at 0x8db06f4
REFCNT = 1
FLAGS = (PADTMP,NOK,pNOK)
NV = 1
$ ... some code that leaks ...
Scalars leaked: 1
leaked: sv=0x857a0e0 flags=0x08400000 refcnt=1
allocated at -e:1 by sin
When this is in force, it typically adds an extra 8 + length(filename)
bytes to each SV, so things run a bit slower and use more RAM
("perl -MPOSIX -e 1" uses 20% more RAM on my x86 system).
SVs allocated at runtime are displayed as 'by foo' where op_foo was the op
being executed at the time; SVs allocated at compile-time in the pad for
an op (ie a pad tmp or padsv) are displayed as 'for foo'.
SV's allocated within XS code will be shown as 'by entersub'.
Dave
--
SCO - a train crash in slow motion
Change 24088 by [EMAIL PROTECTED] on 2005/03/28 21:38:44
expand -DDEBUG_LEAKING_SCALARS to instrument the creation of each SV
Affected files ...
... //depot/perl/dump.c#162 edit
... //depot/perl/ext/Devel/Peek/t/Peek.t#3 edit
... //depot/perl/pad.c#41 edit
... //depot/perl/perl.c#590 edit
... //depot/perl/pod/perlhack.pod#84 edit
... //depot/perl/sv.c#789 edit
... //depot/perl/sv.h#166 edit
Differences ...
==== //depot/perl/dump.c#162 (text) ====
@@ -1203,6 +1203,14 @@
sv_catpv(d, ")");
s = SvPVX(d);
+#ifdef DEBUG_LEAKING_SCALARS
+ Perl_dump_indent(aTHX_ level, file, "ALLOCATED at %s:%d %s %s%s\n",
+ sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
+ sv->sv_debug_line,
+ sv->sv_debug_inpad ? "for" : "by",
+ sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)",
+ sv->sv_debug_cloned ? " (cloned)" : "");
+#endif
Perl_dump_indent(aTHX_ level, file, "SV = ");
switch (type) {
case SVt_NULL:
==== //depot/perl/ext/Devel/Peek/t/Peek.t#3 (text) ====
@@ -28,6 +28,8 @@
local $/;
$pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
$pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
+ # handle DEBUG_LEAKING_SCALARS prefix
+ $pattern =~ s/^(\s*)(SV =.* at )/$1ALLOCATED at .*?\n$1$2/mg;
print $pattern, "\n" if $DEBUG;
my $dump = <IN>;
print $dump, "\n" if $DEBUG;
==== //depot/perl/pad.c#41 (text) ====
@@ -434,7 +434,11 @@
"Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
PL_op_name[optype]));
+#ifdef DEBUG_LEAKING_SCALARS
+ sv->sv_debug_optype = optype;
+ sv->sv_debug_inpad = 1;
return (PADOFFSET)retval;
+#endif
}
/*
==== //depot/perl/perl.c#590 (text) ====
@@ -827,8 +827,16 @@
if (SvTYPE(sv) != SVTYPEMASK) {
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
" flags=0x08%"UVxf
- " refcnt=%"UVuf pTHX__FORMAT "\n",
- sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE);
+ " refcnt=%"UVuf pTHX__FORMAT "\n"
+ "\tallocated at %s:%d %s %s%s\n",
+ sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
+ sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
+ sv->sv_debug_line,
+ sv->sv_debug_inpad ? "for" : "by",
+ sv->sv_debug_optype ?
+ PL_op_name[sv->sv_debug_optype]: "(none)",
+ sv->sv_debug_cloned ? " (cloned)" : ""
+ );
}
}
}
==== //depot/perl/pod/perlhack.pod#84 (text) ====
@@ -2310,10 +2310,13 @@
equivalent of setting this variable to the value 1.)
If, at the end of a run you get the message I<N scalars leaked>, you can
-recompile with C<-DDEBUG_LEAKING_SCALARS>, which will cause
-the addresses of all those leaked SVs to be dumped; it also 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.
+recompile with C<-DDEBUG_LEAKING_SCALARS>, which will cause the addresses
+of all those leaked SVs to be dumped along with details as to where each
+SV was originally allocated. This information is also displayed by
+Devel::Peek. Note that the extra details recorded with each SV increases
+memory usage, so it shouldn't be used in production environments. It also
+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.
=head2 Profiling
==== //depot/perl/sv.c#789 (text) ====
@@ -165,8 +165,19 @@
* "A time to plant, and a time to uproot what was planted..."
*/
+#ifdef DEBUG_LEAKING_SCALARS
+# ifdef NETWARE
+# define FREE_SV_DEBUG_FILE(sv) PerlMemfree((sv)->sv_debug_file)
+# else
+# define FREE_SV_DEBUG_FILE(sv) PerlMemShared_free((sv)->sv_debug_file)
+# endif
+#else
+# define FREE_SV_DEBUG_FILE(sv)
+#endif
+
#define plant_SV(p) \
STMT_START { \
+ FREE_SV_DEBUG_FILE(p); \
SvANY(p) = (void *)PL_sv_root; \
SvFLAGS(p) = SVTYPEMASK; \
PL_sv_root = (p); \
@@ -200,6 +211,17 @@
SvANY(sv) = 0;
SvREFCNT(sv) = 1;
SvFLAGS(sv) = 0;
+ sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
+ sv->sv_debug_line = (U16) ((PL_copline == NOLINE) ?
+ (PL_curcop ? CopLINE(PL_curcop) : 0) : PL_copline);
+ sv->sv_debug_inpad = 0;
+ sv->sv_debug_cloned = 0;
+# ifdef NETWARE
+ sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
+# else
+ sv->sv_debug_file = PL_curcop ? savesharedpv(CopFILE(PL_curcop)): NULL;
+# endif
+
return sv;
}
# define new_SV(p) (p)=S_new_SV(aTHX)
@@ -5822,7 +5844,14 @@
SvREFCNT(sv) = 0;
sv_clear(sv);
assert(!SvREFCNT(sv));
+#ifdef DEBUG_LEAKING_SCALARS
+ sv->sv_flags = nsv->sv_flags;
+ sv->sv_any = nsv->sv_any;
+ sv->sv_refcnt = nsv->sv_refcnt;
+#else
StructCopy(nsv,sv,SV);
+#endif
+
#ifdef PERL_COPY_ON_WRITE
if (SvIsCOW_normal(nsv)) {
/* We need to follow the pointers around the loop to make the
@@ -10727,6 +10756,19 @@
/* create anew and remember what it is */
new_SV(dstr);
+
+#ifdef DEBUG_LEAKING_SCALARS
+ dstr->sv_debug_optype = sstr->sv_debug_optype;
+ dstr->sv_debug_line = sstr->sv_debug_line;
+ dstr->sv_debug_inpad = sstr->sv_debug_inpad;
+ dstr->sv_debug_cloned = 1;
+# ifdef NETWARE
+ dstr->sv_debug_file = savepv(sstr->sv_debug_file);
+# else
+ dstr->sv_debug_file = savesharedpv(sstr->sv_debug_file);
+# endif
+#endif
+
ptr_table_store(PL_ptr_table, sstr, dstr);
/* clone */
@@ -11540,6 +11582,8 @@
# ifdef DEBUGGING
Poison(my_perl, 1, PerlInterpreter);
+ PL_op = Nullop;
+ PL_curcop = Nullop;
PL_markstack = 0;
PL_scopestack = 0;
PL_savestack = 0;
@@ -11572,6 +11616,8 @@
# ifdef DEBUGGING
Poison(my_perl, 1, PerlInterpreter);
+ PL_op = Nullop;
+ PL_curcop = Nullop;
PL_markstack = 0;
PL_scopestack = 0;
PL_savestack = 0;
==== //depot/perl/sv.h#166 (text) ====
@@ -68,6 +68,13 @@
void* sv_any; /* pointer to something */
U32 sv_refcnt; /* how many references to us */
U32 sv_flags; /* what we are */
+#ifdef DEBUG_LEAKING_SCALARS
+ unsigned sv_debug_optype:9; /* the type of OP that allocated us */
+ unsigned sv_debug_inpad:1; /* was allocated in a pad for an OP */
+ unsigned sv_debug_cloned:1; /* was cloned for an ithread */
+ unsigned sv_debug_line:16; /* the line where we were allocated */
+ char * sv_debug_file; /* the file where we were allocated */
+#endif
};
struct gv {
